PowerPoint VBA - кажется, что передача фигур по значению происходит по ссылке - PullRequest
Новая
       10

PowerPoint VBA - кажется, что передача фигур по значению происходит по ссылке

0 голосов
/ 28 сентября 2018

Для части сценария 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

Я думаю, я могу обойти это с помощью специальногоСоглашение об именовании моих новых фигур, а затем отфильтровываю их.Может быть, есть лучший способ?Но на самом деле я просто хотел бы понять, почему это не так, как я ожидаю.

Ответы [ 2 ]

0 голосов
/ 29 сентября 2018

Решение состоит в том, чтобы использовать объект 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
0 голосов
/ 28 сентября 2018

Не совсем точно, что вы пытаетесь сделать, но это распространенное заблуждение, что передача ссылки на объект 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
...