将表格从Excel复制到PowerPoint时找不到形状-VBA在完成粘贴功能之前会运行到下一行

Question

作为PowerPoint报表自动化的一部分，我将从Excel启用宏的工作簿中复制表格到PowerPoint演示文稿，并从Excel运行VBA代码。 这是一个更大的项目的一部分，但是代码的关键部分如下：

Sub test()
    Dim mainWb As Workbook
    Dim graphsWs As Worksheet
    Dim pptApp As PowerPoint.Application
    Dim pptTemp As PowerPoint.Presentation
    Dim pptSlide As PowerPoint.slide
    Dim shp As PowerPoint.Shape

    Set mainWb = ThisWorkbook
    Set graphsWs = mainWb.Sheets(1)
    Set pptApp = New PowerPoint.Application
    Set pptTemp = pptApp.Presentations.Add
    Set pptSlide = pptTemp.Slides.AddSlide(1, pptTemp.SlideMaster.CustomLayouts(1))
    With pptSlide
        .Name = "Destination"
        graphsWs.Range("A2:B4").Copy
        .Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
        DoEvents
        Debug.Print (.Shapes(.Shapes.Count).Name) ' Should print "Table X", but instead prints "Subtitle"
    End With
End Sub

问题： Debug.Print行的名称为“ Subtitle 2”，我希望它能给我“ Table 3”，因为该表是最近复制到工作表中的东西。 另外，当我在执行代码后，尝试在PowerPoint VBA中在立即窗口中编写?ActivePresentation.Slides(1).Shapes(ActivePresentation.Slides(1).Shapes.Count).Name我得到表3正如我所期望的。

假设：脚本的运行似乎并没有等待粘贴代码的行（ .Application.CommandBars.ExecuteMso ("PasteSourceFormatting")在执行下一行之前完成。如果为true，则会给出结果我知道（据我了解）。

可能的解决方法 ：如果我的假设是正确的，那么使用Application.Wait -statement可能会起作用，但是，我不喜欢仅等待几毫秒或几秒钟的想法，因为不同计算机上的不同用户将使用这个脚本。

问题 ：是否有更好的方法告诉应用程序在繁忙时等待？ （在PowerShell Web while($ie.Busy){Sleep 1}网脚本中，我以前使用过类似的东西： while($ie.Busy){Sleep 1} ，但是我似乎在Excel VBA中找不到类似的东西。

PS ：感谢Tim指出了这个相关问题。 我已经添加了DoEvents ，但它似乎仍然无法解决问题...

非常感谢您的任何帮助！

Answer 1

您可以尝试在粘贴之前获取.Shapes.Count的值，然后进入DoEvents循环，直到该值增加一。 将时间限制也放在循环上可能是一个好主意。

Dim i As Long, t

With pptSlide
    .Name = "Destination"
    i = .Shapes.Count
    graphsWs.Range("A2:B4").Copy
    .Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
    t = Timer
    Do While .Shapes.Count = i 
        DoEvents
        If Timer - t > 2 Then Exit Do '<< exit after a couple of seconds
    Loop
    Debug.Print (.Shapes(.Shapes.Count).Name) 
End With

Answer 2

根据@TimWilliams的建议，以下代码有效：

Sub test()
    Dim mainWb As Workbook
    Dim graphsWs As Worksheet
    Dim pptApp As PowerPoint.Application
    Dim pptTemp As PowerPoint.Presentation
    Dim pptSlide As PowerPoint.slide
    Dim shp As PowerPoint.Shape
    Dim i As Long, shapesCount As Long
    i = 0 ' Counter for DoEvents Loop
    shapesCount = 0
    Set mainWb = ThisWorkbook
    Set graphsWs = mainWb.Sheets(1)
    Set pptApp = New PowerPoint.Application
    Set pptTemp = pptApp.Presentations.Add
    Set pptSlide = pptTemp.Slides.AddSlide(1, pptTemp.SlideMaster.CustomLayouts(1))
    With pptSlide
        .Name = "Destination"
        graphsWs.Range("A2:B4").Copy
        .Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
        shapesCount = .Shapes.Count
        Do While shapesCount = .Shapes.Count
            DoEvents
            i = i + 1
            If i > 10000 Then Exit Do
        Loop
        Debug.Print (.Shapes(.Shapes.Count).Name)
        Debug.Print (i)
    End With
End Sub

建议是： 您可以尝试在粘贴之前获取.Shapes.Count的值，然后进入DoEvents循环，直到该值增加一。 将时间限制也放入循环中可能是一个好主意