VBA - how to apply Chart Template after pasting Excel chart into PowerPoint

Question

Sub printDashboard()

    Dim sheet1 As Excel.Worksheet
    Set sheet1 = ActiveWorkbook.Sheets("PM Dashboard")

    Dim pptChart2 As Excel.ChartObject

    'Open PowerPoint template
    Dim sPath As String
    sPath = ActiveWorkbook.Path
    Dim pp As PowerPoint.Application, pps As PowerPoint.Presentation
    Set pp = New PowerPoint.Application
    pp.Visible = True
    Set pps = pp.Presentations.Open(sPath & "\template_Slides.pptx")
    Dim firstSlide As PowerPoint.Slide
    Set firstSlide = pps.Slides(1)    

    'Paste the second chart
    Set pptChart2 = sheet1.ChartObjects("chartPM2")
    pptChart2.Copy
    Dim myShape2 As Object
    Set myShape2 = firstSlide.Shapes.PasteSpecial()
    'myShape2.Chart.ApplyChartTemplate (sPath & "\pipelineManagementChartFormat.crtx")
    With myShape2
        .Top = 1.52 * 72
        .Left = 5.33 * 72
        .Width = 4.08 * 72
        .Height = 2.6 * 72
    End With

End Sub

So this code works perfectly in that it:

• Correctly opens the PowerPoint file
• The Excel chart is pasted in and resized / repositioned

However, I can not figure out how to apply a saved chart template that I have within the same directory. You can see that I have tried to accomplish this with the "ApplyChartTemplate" line that is commented out in the "Paste Second Chart" section.

I would appreciate any help here. I have tried a number of different ways to apply the chart template after pasting it into the slide. I have not had any success with that yet.

Thanks

Answer 1

It may be a machine-dependant timing issue (pasting from the clipboard can result in the VBA code running ahead prior to the paste operation completing). Try calling this Delay sub immediately after the PasteSpecial line.

Delay 1, True

Public Sub Delay(Seconds As Single, Optional DoAppEvents As Boolean)
  Dim TimeNow As Long
  TimeNow = Timer
  Do While Timer < TimeNow + Seconds
    If DoAppEvents = True Then DoEvents
  Loop
End Sub

Answer 2

PasteSpecial returns a shaperange, not shape, but you need to apply a template to a single shape (ie, the chart object). Try this instead:

Set myShape2 = firstSlide.Shapes.PasteSpecial()(1)