Consulting

Results 1 to 4 of 4

Thread: Excel charts as jpgs to specific powerpoint

  1. #1
    VBAX Newbie
    Joined
    Jan 2018
    Location
    Zurich
    Posts
    2
    Location

    Red face Excel charts as jpgs to specific powerpoint

    Hi guys,


    I am new and please forgive me, if am not specific enough.


    I would like to export all of the charts using vba code in a horizontal order from a specific worksheet (sheet1) to a specific powerpoint which is already saved at the end of a given path.
    The powerpoint file as well as the path where it is located are given in cells (please find the attached excel with charts, Cells W7 and W8).


    Could you please help me with the code?


    Thank you in advance.

    Capture.JPG
    Excel.xlsx

  2. #2
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    You really want to copy the charts and paste them into the PowerPoint presentation. This requires VBA that

    - Accesses PowerPoint
    - Opens the PowerPoint file
    - Copies an Excel chart
    - Pastes the chart in a given format onto a slide (and use PNG, not JPG)

    If you search this forum for 'paste excel chart into powerpoint', you should find some pages that will get you started.
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  3. #3
    VBAX Newbie
    Joined
    Jan 2018
    Location
    Zurich
    Posts
    2
    Location
    Hi guys,

    I got further, please find the code below.

    HTML Code:
    Sub ExcelToPowerPoint()
    
    
        Dim cht As ChartObject
        Dim cht2 As ChartObject
        Dim rng As Excel.Range
        Dim PowerPointApp As PowerPoint.Application
        Dim myPresentation As PowerPoint.Presentation
        Dim mySlide As PowerPoint.Slide
        Dim myShapeRange As PowerPoint.Shape
        Dim i As Long, j As Long
        
        'Create an Instance of PowerPoint
        On Error Resume Next
        'Is PowerPoint already opened?
        Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        
        'Clear the error between errors
        err.Clear
    
        'If PowerPoint is not already open then open PowerPoint
        If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
        
        'Handle if the PowerPoint Application is not found
        If err.Number = 429 Then
            MsgBox "PowerPoint could not be found, aborting."
            Exit Sub
        End If
    
        On Error GoTo 0
      
        'Open presentation listed in W7 and W8
        On Error GoTo err
        Set myPresentation = PowerPointApp.Presentations.Open(Range("w8") & "" & Range("w7"))
        
        'Make PowerPoint Visible and Active
        PowerPointApp.Visible = True
        PowerPointApp.Activate
        
        i = 0 'counter for chart
        j = 0 'counter for slide
        
        For Each cht In Worksheets("Nice").ChartObjects
            'Add a slide to the Presentation
            If i Mod 2 = 0 Then
                j = j + 1
            End If
            
            Set mySlide = myPresentation.Slides(j)
            
            'Copy Excel Range
            cht.Activate
            ActiveChart.ChartArea.Copy
            
            'Paste to PowerPoint
            mySlide.Shapes.PasteSpecial DataType:=ppPasteJPG
            Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
                With myShape
                    .LockAspectRatio = True
                    .Width = 200 'points wide
                End With
            'Set position:
            myShape.Left = 40 + ((i Mod 2) * 250)
            myShape.Top = 66
            i = i + 1
            
        Next cht
        
            For Each cht2 In Worksheets("Beautiful").ChartObjects
            'Add a slide to the Presentation
            If i Mod 2 = 0 Then
                j = j + 1
            End If
            
            Set mySlide = myPresentation.Slides(j)
            
            'Copy Excel Range
            cht2.Activate
            ActiveChart.ChartArea.Copy
            
            'Paste to PowerPoint
            mySlide.Shapes.PasteSpecial DataType:=ppPasteJPG
            Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
                With myShape
                    .LockAspectRatio = True
                    .Width = 200 'points wide
                End With
            'Set position:
            myShape.Left = 40 + ((i Mod 2) * 250)
            myShape.Top = 66
            i = i + 1
            
        Next cht2
        Exit Sub
        
    err:
    MsgBox "File name does not exist, please check and try again"
    End Sub
    Three issues are bothering me however.
    1. I get "out of memory error"
    2. I get the msg box "File name does not exist, please check and try again" although the job has been done appropriately (powerpoint opened, pictures pasted).
    3. In the sheet "Nice" I prepared three charts in one line. Unfortunately only two are being pasted.

    Could you please comment on that?
    Attached Files Attached Files
    Last edited by sandra.pa; 01-23-2018 at 12:21 AM.

  4. #4
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    You have "On Error GoTo err", and err gives you the "File doesn't exist" error. If the file is opened, then the error occurs later in the code, but it still gives the message in err. Obviously something else caused the error.

    Remove the On Error, and see where the code halts, and fix that problem. Since the third chart isn't pasted, I suspect there's a problem with the third time through the loop.
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •