PowerPoint VBA 在 运行 期间无法识别 Excel table

PowerPoint VBA does not recognize Excel table during run

我有一段代码可以从我的 excel 文件中复制一个范围并将其粘贴到 PowerPoint 中的活动幻灯片上。经过数小时的尝试将 excel 的范围粘贴为 table(不是图像),我发现以下代码可以成功运行。注:myPP = powerpoint application.

myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPP.CommandBars.ReleaseFocus

问题是当我执行宏时,table 被粘贴,但是 vba 不识别 table 除非代码被单步执行。我用下面的代码测试了这个。在执行过程中,代码会被完全跳过,但在单步执行过程中会触发。

For Each shp In activeSlide.Shapes
   If shp.HasTable Then
       MsgBox shp.Name
   End If
Next

下面是完整代码。基本上,我只想将 excel 范围作为 table 粘贴到我的 powerpoint 中,然后扩展 table 以适合幻灯片。我对修改它的建议持开放态度。感谢您的帮助

Dim myPP as Object
Dim activeSlide as Object
Dim shp as Object

Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(Cells(1,1), Cells(4,7)).Copy
Worksheets("Sheet1").Activate

myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPP.CommandBars.ReleaseFocus

Dim myTable As String
   For Each shp In activeSlide.Shapes
       If shp.HasTable Then
           MsgBox shp.Name
           myTable = shp.Name
       End If
   Next

With activeSlide.Shapes(myTable)
      .Left = 23
      .Top = 105
      .Width = 650
      .Height = 375
End With

Dim myPP As Object          'Powerpoint.Application
Dim myPres As Object        'Powerpoint.Presentation
Dim activeSlide As Object   'Powerpoint.Slide


Set myPP = CreateObject("Powerpoint.Application")
myPP.Visible = True
Set myPres = myPP.Presentations.Add
myPP.ActiveWindow.ViewType = 1   'ppViewSlide
Set activeSlide = myPres.slides.Add(1, 12) 'ppLayoutBlank

问题在于我们无法预测粘贴操作将持续多长时间以及何时完成。我们需要等待它完成。

' first let us count the shapes in the slide
Dim shapeCount As Integer: shapeCount = activeSlide.Shapes.Count
myPP.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until activeSlide.Shapes.Count > shapeCount

' Now, our table is the last in the shapes collection.
With activeSlide.Shapes(activeSlide.Shapes.Count)
    .Left = 23
    .Top = 105
    .Width = 650
    .Height = 375
End With