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

问题

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

I use the above code (only part of a code is shown) to copy cell ranges from excel and paste as tables in ppt that can be edited. The error occurs in the line 'PPSlide.Shapes(shapecount).Select ' It fails since shapecount = 0 . But if i choose to debug and run the previous line to count shapes, then shapecount is set to 1 and the code runs smooth. I am puzzled. Need help

回答1:

Based on Marek Stejskal's suggestion, maybe give this a try:

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

If i < 1000 isn't enough, try increasing it until either

it completes successfully, or
you get tired of waiting for it

回答2:

This is a tricky one. The problem lies in the way you are pasting the data into PowerPoint. If you were using standard VBA commands, the pasting would run in a sequence, meaning the code would wait until the data is successfully pasted.

By using ExecuteMso you can never be sure what's going on.

Try experimenting with this command

PPApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault

and with different DataType values to achieve your goal.

来源：https://stackoverflow.com/questions/29777799/vba-code-works-in-debug-mode-but-fails-to-run-in-whole

标签

vba

excel-vba

powerpoint-vba

excel