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意味着您传递的是对象指针的副本 ，而不是 reference 指向相同的对象指针。

在两种情况下，您都传递了一个指向完全相同的对象的对象指针，因此，当.AddShape时，您将更改迭代过程中完全相同的形状集合。 / p>

传递对象引用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

Answer 2

解决方案是使用ShapeRange对象，该对象“代表形状范围，它是文档上一组形状的集合。”

Shapes文档中的注释：

如果要使用文档中形状的子集（例如，仅对文档中的“自选图形”或仅对选定的形状执行某些操作），则必须构造一个ShapeRange集合，其中包含所需的形状与之合作。

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


Sub LabelShapes(ByVal ss As ShapeRange)
    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

PowerPoint VBA-通过值传递形状似乎是通过引用进行的

2 个答案: