Excel VBA PowerPoint图表复制关闭mid格式化程序
Excel VBA PowerPoint图表复制关闭mid格式化程序
提问于 2016-06-14 23:40:25
我有一个过程，它打开一个.ppt模板，并从Excel中复制图表和表格，用于多代演示文稿( Do循环)。这看起来像是每隔一次发生一次事件，在过程执行PPT.Quit之前，通过在完成WITH语句之前关闭.ppt，在输入WITH语句之后，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回答 1
Stack Overflow用户
发布于 2016-06-15 01:38:32
这是一个难题，每次我尝试粘贴图表图片时，都会遇到PowerPoint关闭的问题。因此，为了解决这个问题，我使用了一些东西：
- 为PowerPoint项(应用程序、演示文稿、幻灯片)创建单独的对象。这使您可以更好地控制每个对象如何作用于进程中的数据/对象。它在调试时也更加清晰。当然，您创建了更多的变量，但它也产生了更清晰的代码。
- 我的示例使用了PowerPoint对象库的早期绑定，但它也可以使用后期绑定。我发现使用早期绑定更容易解决问题，只需使代码可操作，然后在需要时将其返回到后期绑定。
- 您不需要在代码中使用
Select和Activate。这几乎不是必须的，因为对象本身可以采取适当的操作。 - 我遇到了一个有趣的post VBA Crashing When Pasting into PowerPoint，这导致我插入了下面所示的延迟计时器。一旦我确保所有的PPT对象都是正确的，代码就可以正常运行了。
- 由于原始
Presentation的打开方式，我的示例代码被强制转换为SaveAs。
下面的代码每次都会为我运行，没有错误。
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/37816516
复制相关文章
相似问题
腾讯云开发者
