VBA 代码在调试模式下工作，但无法完整运行 [英] 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

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

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

推荐答案

基于 Marek Stejskal 的建议，也许试试这个:

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

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

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

• 它成功完成，或者
• 你已经厌倦了等待

这篇关于VBA 代码在调试模式下工作，但无法完整运行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！