Paste Excel Chart into Existing Powerpoint Chart

D

dcusick

Joined
Apr 30, 2012
Messages
2
Reaction score
0
Hi All. I have a Powerpoint slide, that has a Chart Object on it now. I have different lines and text boxes in there. I currently manually paste a chart from Excel, into this Chart Object in Powerpoint, by clicking on the chart Object, and then just hitting Ctrl-P. I do this, because then the lines and text boxes are on top of my pasted chart, so all things are visible. So, I want to automate this process in VBA. I have all code in place to copy the chart, and paste it into the slide. However, I cannot seem to figure out how to paste into the actual Chart Object on that slide. Basically, here is what I have. I can grab a specific chart from Excel. Then open Powerpoint, and loop through the shapes on the slide, until I find my Chart Object. At that point, I would like to paste INTO that object.

Somehting like ppShape.PasteSpecial xxxx. But PasteSpecial is not available to the ppShape object. Any thoughts or ideas? Thanks all.


Code: 
Sub PasteGraphsToPowerpoint()

    Dim ppApp As PowerPoint.Application
    Dim ppSlide As PowerPoint.Slide
    Dim ppOb As Object
    Dim ppShape As PowerPoint.Shape
    
    'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
     
     'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
     'Add a presentation if none exists
    'If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
     
     If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Open "MyPresentation.pptx"
     
     'Make the instance visible
    ppApp.Visible = True
    
    
    Set ppSlide = ppApp.ActiveWindow.View.Slide
    
    
    
    ActiveSheet.ChartObjects("Chart 7").Select
    ActiveChart.ChartArea.Copy
    
    For Each ppShape In ppSlide.Shapes
        If ppShape.Name = "Chart 15" Then
            ppShape.Select msoTrue
            MsgBox "This is the shape I want to paste in!"
        End If
    Next
    
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    Set ppApp = Nothing

End Sub
 
Okay, after two days of trying to figure this out, I just decided to go a different direction. I decided to keep the chart object around, but just use it as a type of placeholder. So, I just decided to paste the spreadsheet to each slide, and then use the chart object to get the size and position that the pasted chart should have. Once I had the size and position set properly, I hid the placeholder. I'll paste the code here, in case anyone looks for something similar, in the future...

Code: 
Sub PasteGraphsToPowerpoint()

    Dim ppApp As PowerPoint.Application
    Dim ppSlide As PowerPoint.Slide
    Dim ppOb As Object
    Dim ppShape As PowerPoint.Shape
    Dim blnFound As Boolean
    Dim iCht As Integer
    
    Sheets("Sheet1").Activate
    
    'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
     
     'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
     'Add a presentation if none exists
    'If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
     
     If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Open "Template_Final.pptx"
     
     'Make the instance visible
    ppApp.Visible = True
        
    For iCht = 1 To ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(iCht).Chart.HasTitle = False
        ActiveSheet.ChartObjects(iCht).Chart.ChartArea.Copy
        
        ppApp.ActiveWindow.View.GotoSlide (iCht)
        Set ppSlide = ppApp.ActiveWindow.View.Slide

        blnFound = False
        For Each ppShape In ppSlide.Shapes
            If Not blnFound Then
                If InStr(1, ppShape.Name, "Chart") > 0 Then
                    blnFound = True
    
                    ppSlide.Shapes.Paste.Select
                    With ppApp.ActiveWindow.Selection.ShapeRange
                        .LockAspectRatio = msoFalse
                        .ZOrder (msoSendToBack)
                        .Width = ppShape.Width
                        .Height = ppShape.Height
                        .Left = ppShape.Left
                        .Top = ppShape.Top
                    End With
                    
                    ppShape.Visible = msoFalse
                End If
            End If
        Next
        
        ActiveSheet.ChartObjects(iCht).Chart.HasTitle = True
    Next


    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    Set ppApp = Nothing

End Sub
 
Back
Top