问题描述
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
如果我
If i < 1000 isn't enough, try increasing it until either
- 它成功完成,或者
- 你已经厌倦了等待
这篇关于VBA 代码在调试模式下工作,但无法完整运行的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!