从 Excel 复制到 PowerPoint 时出现 .Paste 错误

Question

我正在尝试使用 Excel VBA 将数据从 Excel 复制到 PowerPoint。

有时它会在运行过程中崩溃并停止。

Sub Test()

Set PowerPointApp = CreateObject("PowerPoint.Application")
Set ppApp = New powerpoint.Application
ppApp.Visible = True
DestinationPPT = "C:\Users\Saeed\Desktop\edit vba\test.pptx"
Set ppPres = PowerPointApp.Presentations.Open(DestinationPPT)
Sheets("Slide3").Activate
Sheets("Slide3").Range("A2").Select
Selection.Copy
ppApp.Activate
ppPres.Slides(3).Select
ppApp.Windows(1).View.Paste
Set shp = ppPres.Slides(3).Shapes(ppPres.Slides(3).Shapes.Count)
shp.Left = 17
shp.Top = 90
ppApp.Windows(1).Selection.Unselect

ppPres.SaveAs "C:\Users\Saeed\Desktop\edit vba\" & FileName, ppSaveAsPDF
ppPres.Close
ppApp.Quit
Set ppt = Nothing

我跳过了暗淡的部分和一些不重要的部分。

它崩溃了

ppApp.Windows(1).View.Paste

我不知道如何修复它，因为它有时运行完美。

我尝试使用On Error Goto，但没有任何改变。

Answer 1

我的第一个猜测是您不应该将其粘贴到视图中，而是粘贴到幻灯片中。

ppPres.Slides(3).shapes.paste

干杯 延斯

Answer 2

我想指出的一件事是在您的代码中，您在后期绑定和早期绑定之间跳转。我不知道这是否是故意的，但理想情况下，您只想选一个。在我的解决方案中，我假设您想要提前绑定。

现在我建议您做的另一件事是确保您声明我们所有的变量，这样您就可以更简洁地编写代码，并且更容易知道我们是哪个对象合作。

您遇到问题的原因可能是几个不同的问题，但其中一个可能与剪贴板有关。 我怀疑这是因为您说错误是偶发的，这通常表示剪贴板错误。幸运的是，我们可以实施一些解决方案。我的首选解决方案是暂停 Excel 应用程序一到两秒钟，以确保信息进入剪贴板。此解决方案通常可以修复 95% 的与剪贴板相关的错误。

话虽如此，它不会在 100% 的时间里起作用。尽管这听起来很奇怪，但我们仍然会遇到信息从剪贴板中消失的情况。

另外，如果您不熟悉 Excel VBA 和 PowerPoint VBA 协同工作，我有一些 YouTube 视频可以讨论这个主题。如果您认为自己想要编写更复杂的脚本，请随时查看它们。

https://www.youtube.com/playlist?list=PLcFcktZ0wnNlFcSydYb8bI1AclQ4I38VN

试试这段代码，告诉我你得到了什么：

Sub Test()

'Declare Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTShape As PowerPoint.Shape

'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
    PPTApp.Visible = True

'File Path
DestinationPPT = "C:\Users\Saeed\Desktop\edit vba\test.pptx"

'Open the File
Set PPTPres = PPTApp.Presentations.Open(DestinationPPT)

'Copy Range "A2" on the sheet.
Sheets("Slide3").Activate
Sheets("Slide3").Range("A2").Copy

'Pause the Excel Applicaiton for one second. This is for stability issues that may arise.
Application.Wait Now() + #12:00:01 AM#

'Paste the Range on the Slide
PPTPres.Slides(3).Shapes.Paste

Set PPTShape = PPTPres.Slides(3).Shapes(PPTPres.Slides(3).Shapes.Count)
    PPTShape.Select

'Set Dimensions of Shape
With PPTShape
    .Left = 17
    .Top = 90
End With

'Save & Close the file
PPTPres.SaveAs "C:\Users\Saeed\Desktop\edit vba\" & Filename, ppSaveAsPDF
PPTPres.Close
PPTApp.Quit

'Release Objects From Memory
Set PPTApp = Nothing
Set PPTPres = Nothing
Set PPTShape = Nothing

End Sub