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

从Excel复制到PowerPoint时的错误处理

2 个答案: