VBA 代码在调试模式下工作但无法运行整体

Question

Sub Export_as_PDF()
Dim fil As Variant
Dim strfile As String
Dim PPApp As PowerPoint.Application
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Long
Dim ws As Worksheet
Dim Wb As Workbook

Set PPApp = New PowerPoint.Application

PPApp.Presentations.Add

' Slide 1

 PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1,ppLayoutBlank
Set PPSlide = PPApp.ActivePresentation.Slides    (PPApp.ActivePresentation.Slides.Count)
PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
Sheet2.Range("F106").Copy
PPApp.Activate
PPApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

shapecount = PPSlide.Shapes.Count 'Error is here when shapecount = 0
PPSlide.Shapes(shapecount).Select

PPApp.ActiveWindow.Selection.ShapeRange.Left = 15
PPApp.ActiveWindow.Selection.ShapeRange.Top = 15
PPApp.ActiveWindow.Selection.ShapeRange.Width = 100

End Sub

我使用上面的代码（只显示了部分代码）从excel复制单元格范围并粘贴为可以编辑的ppt中的表格。错误发生在 'PPSlide.Shapes(shapecount).Select ' 行它失败，因为 shapecount = 0 。但是如果我选择调试运行前一行来计算形状，那么 shapecount 设置为 1 并且代码运行是平滑的。我很困惑。需要帮助

Answer 1

这是一个棘手的问题。问题在于将数据粘贴到 PowerPoint 中的方式。如果您使用的是标准 VBA 命令，则粘贴将按顺序运行，这意味着代码将等待数据成功粘贴。

通过使用 ExecuteMso，您永远无法确定发生了什么。

尝试使用此命令进行试验

PPApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault

并使用不同的 DataType 值来实现您的目标。

Answer 2

根据的建议，也许可以试试这个：

Sub Export_as_PDF()
Dim fil As Variant
Dim strfile As String
Dim PPApp As PowerPoint.Application
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Long
Dim ws As Worksheet
Dim Wb As Workbook
Dim I as integer

  Set PPApp = New PowerPoint.Application

  PPApp.Presentations.Add

' Slide 1

  PPApp.ActivePresentation.Slides.Add _
    PPApp.ActivePresentation.Slides.Count + 1,ppLayoutBlank
  Set PPSlide = PPApp.ActivePresentation.Slides PPApp.ActivePresentation.Slides.Count)
  PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
  Sheet2.Range("F106").Copy
  PPApp.Activate
  PPApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

  i = 0    
  'this loop will wait for .ExecuteMso to do its thing
  'while the "i" counter will prevent it from hanging forever
  While PPSlide.shapes.count = 0 and i < 1000
    do events
    i = i + 1
  wend

  shapecount = PPSlide.Shapes.Count 'Error is here when shapecount = 0
  PPSlide.Shapes(shapecount).Select

  PPApp.ActiveWindow.Selection.ShapeRange.Left = 15
  PPApp.ActiveWindow.Selection.ShapeRange.Top = 15
  PPApp.ActiveWindow.Selection.ShapeRange.Width = 100

End Sub

如果我 < 1000 不够，请尝试增加它直到

成功完成，或者
你已经等腻了

VBA 代码在调试模式下工作但无法运行整体

VBA code works in debug mode but fails to run in whole

excel

powerpoint

vba

VBA 代码在调试模式下工作但无法 运行 整体

VBA code works in debug mode but fails to run in whole

excel

powerpoint

vba

VBA 代码在调试模式下工作但无法运行整体