vba - PowerPoint VBA - 按值传递形状似乎是通过引用发生的

Question

对于我正在组合的 VBA 脚本的一部分，我想迭代当前幻灯片上的所有形状，并在每个形状的顶部插入另一个形状。

我有第一个子例程 GetShapes()，它获取当前幻灯片上的所有形状，然后将它们按值传递给第二个子例程 LabelShapes()，后者将新形状添加到顶部。

但是，新形状似乎显示在传递的 Shapes 对象中。看来情况不应该如此，因为它是通过引用传递的。

警告，下面的内容会快速锁定 PowerPoint

Sub GetShapes()
    Dim ss As Shapes
    Set ss = Application.ActiveWindow.View.Slide.Shapes
    Call LabelShapes(ss)
End Sub


Sub LabelShapes(ByVal ss As Shapes)
    Dim s As Shape
    For Each s In ss
        Debug.Print s.Name
        Application.ActiveWindow.View.Slide.Shapes.AddShape _
            Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=15, Height:=15

    Next

End Sub

我想我可以通过对新形状使用特殊的命名约定然后将其过滤掉来解决这个问题。也许有更好的方法？但是，实际上我只是想了解为什么这没有按照我预期的方式运行。

Answer 1

不确定您到底想要做什么，但传递对象引用 ByVal 会神奇地创建对象的副本，这是一个常见的误解。

传递对象引用 ByVal 意味着您传递对象指针的副本，而不是引用 指向同一个对象指针。

在这两种情况下，您传递的对象指针都指向完全相同的对象，因此当您 .AddShape 时，您正在更改位于中间的完全相同的形状集合迭代。

传递对象引用ByVal不会传递对象的副本。如果您想传递副本，则需要制作副本。

这可能有助于澄清:

Public Sub DoSomething()
    Dim obj As Object
    Set obj = New Collection
    TestByVal obj 'pass a copy of the object reference
    Debug.Assert Not obj Is Nothing
    TestByRef (obj) 'force a copy of the object reference (despite ByRef)
    Debug.Assert Not obj Is Nothing
    TestByRef obj 'pass a reference to the object pointer
    Debug.Assert Not obj Is Nothing ' << assert will fail here
End Sub

Private Sub TestByVal(ByVal obj As Object)
    Set obj = Nothing ' only affects the local copy
End Sub

Private Sub TestByRef(ByRef obj As Object)
    Set obj = Nothing ' DANGER! call site will see this
End Sub