对于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
我想我可以通过对新形状使用特殊的命名约定并过滤掉它们来解决此问题。也许有更好的方法?但是,真的,我只是想了解为什么这不符合我的预期。
答案 0 :(得分:3)
不确定要执行的操作是什么,但这是一个普遍的误解,即传递对象引用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
答案 1 :(得分: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