Question

我有一个程序可以打开一个.ppt模板，并从Excel中复制图表和表格，用于多代演示（Do循环）。似乎是每隔一次的事件，在进入WITH语句后，在完成WITH之前关闭.ppt并且在该过程执行PPT.Quit之前，Excel图表的粘贴在进程中间中断。因此，程序无法找到演示文稿以格式化幻灯片上的形状。

我的搜索没有找到关于如何解决这个问题或者什么原因导致它仅在1/2时间内工作的答案？这是代码：

    'Slide 8 = Contour Overlay Chart
    Sheets("Contour Plot").Select
    'Copy Chart into PowerPoint
    ActiveSheet.ChartObjects("ContourPlot").Activate
    ActiveSheet.ChartObjects("ContourPlot").Activate
    ActiveSheet.ChartObjects("ContourPlot").Chart.CopyPicture _
        appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

PPT.ActivePresentation.Slides(8).Shapes.PasteSpecial Link:=0
NumShape = PPT.ActivePresentation.Slides(8).Shapes.Count
With PPT.ActivePresentation.Slides(8).Shapes(NumShape) 'Here is where it closes .ppt every OTHER instance from a loop before it gets to the next line
    .Height = 390
    .Left = 160
    .Top = 110
End With

Application.CutCopyMode = False

'Save and Close the PowerPoint presentation
PPT.ActivePresentation.Save
PPT.ActivePresentation.Close
'Stop the PowerPoint connection
PPT.Quit

'Clear the memory
Set PPT = Nothing

Answer 1

这是一个谜题，我也遇到了PowerPoint关闭每次我试图粘贴图表图片。所以为了解决这个问题，我使用了一些东西：

为PowerPoint项目（应用程序，演示文稿，幻灯片）创建单独的对象。这使您可以更好地控制每个对象如何对正在处理的数据/对象执行操作。它在调试方面也更加清晰。当然，您正在创建更多变量，但它也会产生更清晰的代码。
我的示例使用PowerPoint对象库的早期绑定，但它可以与后期绑定一样好用。我发现更容易解决早期绑定的问题，只是为了使代码可操作，然后在需要时将其备份到后期绑定。
您不需要在代码中Select和Activate。它几乎从来没有必要，因为对象本身可以采取适当的行动。
我遇到了一篇有趣的帖子VBA Crashing When Pasting into PowerPoint，这导致我插入下面显示的延迟计时器。一旦我确定所有PPT对象都是正确的，那么在没有它的情况下，代码运行正常。
由于原始SaveAs的打开方式，我的示例代码被强制为Presentation。

下面的代码每次都为我运行而没有错误。

Option Explicit

#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Sub CopyChartToPPT()
    Dim pptApp As PowerPoint.Application
    Dim pptPR As PowerPoint.Presentation
    Dim pptSL As PowerPoint.Slide
    Dim cplotSH As Worksheet
    Dim cplotChart As ChartObject
    Dim wb As Workbook
    Dim newestShape As Integer

    Set wb = ThisWorkbook
    Set cplotSH = wb.Sheets("Contour Plot")
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPR = pptApp.Presentations.Open("junkppt1.pptx", ReadOnly:=msoTrue)
    Set pptSL = pptPR.Slides(8)

    Set cplotChart = cplotSH.ChartObjects("ContourPlot")
    cplotChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Dim i As Integer
    'For i = 1 To 6
    '  DoEvents
    '  Sleep 500 'milliseconds
    'Next i

    pptSL.Shapes.PasteSpecial
    newestShape = pptSL.Shapes.Count
    With pptSL.Shapes(newestShape)
        .Height = 390
        .Left = 160
        .Top = 110
    End With

    pptPR.SaveAs Filename:="differentname.pptx"
    pptPR.Close
    Set pptPR = Nothing
    Set pptApp = Nothing
End Sub

Excel VBA PowerPoint图表复制关闭中间格式化过程

1 个答案: