将对象从 powerpoint 演示文稿复制到 Excel，但未粘贴到正确的范围内

Question

所以我有一些 VBA 代码从 PowerPoint 复制一个对象（在本例中为文本框）并将其粘贴到工作簿中的特定范围内。 它有 90%，但是在一张纸上粘贴多个文本框时会出现问题。 下面的代码粘贴了来自 10 个不同幻灯片的 10 个不同的文本框。 幻灯片 4-7 粘贴在同一张纸上，但有 4 个不同的范围。 然而，幻灯片 4-6 是叠在一起粘贴的，只是按照第一个的粘贴范围，但由于某种原因，幻灯片 7 的对象在正确的范围内。

为了解决这个问题，我尝试在中间添加等待时间，我也尝试更改所有幻灯片的复制和粘贴顺序，但没有任何效果。 是否有人可以帮助我解决这个？

Dim Ppt As PowerPoint.Application

Sub Ppt_Extract_Shapes()
    'Add VBA References to PowerPoint 16.0 Type Library '''

    Set Ppt = VBA.CreateObject("PowerPoint.application")

    Dim filePath As String
    filePath = "put_your_file_name_here"

    With Ppt
        .Visible = msoTrue
        .Presentations.Open (filePath)

            paste_from_slide 3, "Summary", "M12"
            paste_from_slide 4, "Summary2", "F24"
            paste_from_slide 5, "Summary2", "F40"
            paste_from_slide 6, "Summary2", "F65"
            paste_from_slide 7, "Summary2", "F91"
            paste_from_slide 8, "Wages", "M11"
            paste_from_slide 9, "Supplies", "L9"
            paste_from_slide 10, "Ancillary", "M11"
            paste_from_slide 11, "Fixed", "AB4"
            paste_from_slide 11, "Debt", "S28"

        .Quit
    End With

End Sub

Function paste_from_slide(slideIndex As Integer, targetWsName As String, _
                          destinationRng As String, _
                          Optional shapeName As String = "Content Placeholder 1")

    Dim pptShape As PowerPoint.Shape
    Dim pptSlide As PowerPoint.Slide
    Dim exlShape As Excel.Shape

    Dim Ws As Excel.Worksheet
    Dim Rng As Excel.Range

    Set Ws = Excel.ThisWorkbook.Worksheets(targetWsName)
    Set Rng = Ws.Range(destinationRng)

    Set pptSlide = Ppt.ActivePresentation.Slides(slideIndex)
    Set pptShape = pptSlide.Shapes(shapeName)
        pptShape.Copy
        Ws.Paste
    Set exlShape = Ws.Shapes(shapeName)
        exlShape.Left = Rng.Left
        exlShape.Top = Rng.Top

End Function

Answer 1

这可能是你的问题：

 Set exlShape = Ws.Shapes(shapeName)

不能保证 Excel 中形状的名称是唯一的。

如果您想要最后粘贴的形状，那么这非常可靠：

 Set exlShape = Ws.Shapes(Ws.Shapes.Count)