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中可以编辑的表格。错误发生在＆＃39; PPSlide.Shapes（shapecount）行中。选择＆＃39; 它因shapecount = 0而失败。但是如果我选择调试并运行前一行来计算形状，那么shapecount设置为1并且代码运行顺畅。我很困惑。需要帮助

Answer 1

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

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

尝试使用此命令

PPApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault

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

Answer 2

根据Marek Stejskal的建议，也许试一试：

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

如果我＆lt; 1000是不够的，尝试增加它直到

成功完成，或
你厌倦了等待它

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

2 个答案: