VBA

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 图表已粘贴并调整大小/重新定位

但是，我不知道如何应用我在同一目录中保存的图表模板。您可以看到我已尝试使用 "Paste Second Chart" 部分中注释掉的 "ApplyChartTemplate" 行来完成此操作。

如有任何帮助，我将不胜感激。将图表模板粘贴到幻灯片后，我尝试了多种不同的方法来应用图表模板。我还没有成功。

谢谢

Answer 1

这可能是一个与机器相关的计时问题（从剪贴板粘贴可能导致 VBA 代码运行在粘贴操作完成之前提前。尝试在 PasteSpecial 行之后立即调用此 Delay sub。

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 shaperange，不是shape，但是你需要将模板应用到单个shape（即图表对象）。试试这个：

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

VBA - 如何在将 Excel 图表粘贴到 PowerPoint 后应用图表模板

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

excel

powerpoint