Paste Excel Chart to PPT using VBA

Question

I am trying to copy charts from excel to ppt using the following VBA code. But I am unable to figure out how to copy graphs as charts using the paste special function(Keep source formatting and link data). My code is copying charts as pictures.

Option Explicit

Sub CopyChartToPowerpoint()
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Object
    Dim myShape As Object
    Dim i As Integer

    ' Open PowerPoint presentation
    On Error Resume Next
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    On Error GoTo 0

    Application.ScreenUpdating = False
    ' Open PowerPoint presentation and set the slide
    Set myPresentation = PowerPointApp.Presentations.Open(Filename:="C:\Users\krps\Downloads\In Stock_Support_WSR_12_23_2023_V1.pptx")
    Set mySlide = myPresentation.Slides(4)

    ' Copy and paste the first chart
    ThisWorkbook.Worksheets("KSC_Incident_Summary").ChartObjects("Graph1").Chart.CopyPicture
    mySlide.Shapes.Paste
    Application.CutCopyMode = False

    ' Delete all charts in the slide
    For i = mySlide.Shapes.Count To 1 Step -1
        If mySlide.Shapes(i).Type = msoChart Then
            mySlide.Shapes(i).Delete
        End If
    Next i
    Application.CutCopyMode = False

    ' Set chart position
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 50
        .Top = 90
        .Width = 800
        .Height = 290
    End With

    ' Set the slide for the second chart
    Set mySlide = myPresentation.Slides(4)

    ' Copy and paste the second chart
    ThisWorkbook.Worksheets("L3 Transfer Trends").ChartObjects("Graph2").Chart.CopyPicture
    mySlide.Shapes.Paste
    Application.CutCopyMode = False

    ' Set chart position for the second chart
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 500
        .Top = 92
        .Width = 287
        .Height = 290
    End With
    
'Slide 7
    Set mySlide = myPresentation.Slides(7)

    ' Copy and paste the first chart
    ThisWorkbook.Worksheets("DSR").ChartObjects("Graph3").Chart.CopyPicture
    mySlide.Shapes.Paste
    Application.CutCopyMode = False

    ' Delete all charts in the slide
    For i = mySlide.Shapes.Count To 1 Step -1
        If mySlide.Shapes(i).Type = msoChart Then
            mySlide.Shapes(i).Delete
        End If
    Next i
    Application.CutCopyMode = False

    ' Set chart position
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 52
        .Top = 94
        .Width = 530
        .Height = 270
    End With

    ' Set the slide for the second chart
    Set mySlide = myPresentation.Slides(7)

    ' Copy and paste the second chart
    ThisWorkbook.Worksheets("System vs Manual Metrics").ChartObjects("Graph4").Chart.CopyPicture
    mySlide.Shapes.Paste
    Application.CutCopyMode = False

    ' Set chart position for the second chart
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 500
        .Top = 94
        .Width = 270
        .Height = 270
    End With

    ' Activate PowerPoint
    PowerPointApp.Visible = True
    PowerPointApp.Activate
End Sub

Answer 1

Try replacing...

ThisWorkbook.Worksheets("KSC_Incident_Summary").ChartObjects("Graph1").Chart.CopyPicture

with

ThisWorkbook.Worksheets("KSC_Incident_Summary").ChartObjects("Graph1").Chart.ChartArea.Copy

And the same thing for your other ones.

Hope this helps!