VBA - 如何在將Excel圖表粘貼到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

所以這段代碼的完美之處在於它：

• 正確打開PowerPoint文件
• Excel圖表被粘貼並調整大小/重新定位

但是，我無法弄清楚如何應用我在同一目錄中保存的圖表模板。 您可以看到我已嘗試使用“粘貼第二個圖表”部分中注釋掉的“ApplyChartTemplate”行來完成此操作。

我很感激這里的任何幫助。 在將圖表模板粘貼到幻燈片后，我嘗試了許多不同的方法來應用它。 我還沒有取得任何成功。

謝謝

Answer 1

它可能是與機器相關的計時問題（從剪貼板粘貼可能導致在粘貼操作完成之前VBA代碼正在運行）。 嘗試在PasteSpecial行之后立即調用此Delay子。

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返回一個shaperange，而不是shape，但您需要將模板應用於單個形狀（即圖表對象）。 試試這個：

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