VBA PowerPoint: изменить несколько фигур, используя один и тот же «с» - PullRequest
Новая
       6

VBA PowerPoint: изменить несколько фигур, используя один и тот же «с»

0 голосов
/ 06 июля 2018

У меня есть макрос, в котором я создаю два поля, одно в верхней части слайда, а другое внизу: oBoxTop и oBoxBottom.

В настоящее время у меня есть что-то вроде этого: 

Set oBoxTop = oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)
    With oBoxTop
         .TextFrame.TextRange.Text = "TEXT"
         .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
         .TextEffect.FontSize = 15
    End With

Set oBoxBottom = oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)
    With oBoxBottom
         .TextFrame.TextRange.Text = "TEXT"
         .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
         .TextEffect.FontSize = 15
    End With

Поскольку оба блока должны быть отформатированы одинаково, я надеялся сделать это с помощью всего одного блока кода, а не повторять все, даже если это всего лишь немного сжать код.

Поскольку на слайде есть другие фигуры, которые не нужно менять (нужно изменить только две только что созданные), я пробовал что-то вроде 

With oBoxTop & oBoxBottom

или 

With oBoxTop and oBoxBottom

Ни один из опробованных мной вариантов не сработал. Есть ли способ использовать «с функцией» для нескольких фигур? Или я должен сделать это совершенно по-другому?

Ответы [ 2 ]

0 голосов
/ 06 июля 2018

Передача Array() имен в Shapes.Range() позволяет работать с несколькими фигурами одновременно. 

Set oBoxTop = oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)
Set oBoxBottom = oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)

With oSld.Shapes.Range(Array(oBoxTop.Name, oBoxBottom.Name))
    .TextFrame.TextRange.Text = "TEXT"
    .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
    .TextEffect.FontSize = 15
End With
0 голосов
/ 06 июля 2018

Чтобы расширить мой комментарий о передаче ссылки на форму другой процедуре.

Я не проверял, но это должно выглядеть примерно так: 

Public Sub FormatShape(ShapeReference As Shape)

    With ShapeReference
         .TextFrame.TextRange.Text = "TEXT"
         .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
         .TextEffect.FontSize = 15
    End With

End Sub

Затем вы можете вызвать эту процедуру и передать ей различные формы: 

Sub Main()

    Set oBoxTop = oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)
    FormatShape oBoxTop

    Set oBoxBottom = oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)
    FormatShape oBoxBottom

    ' - - OR - -

    FormatShape oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)
    FormatShape oSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 720, 13)

End Sub

Редактировать: Я обновил имя процедуры - PositionShape вводит в заблуждение. Я действительно должен сначала прочитать вопрос правильно. :)

...