CODEWITHSUNDEEP
vbapowerpoint
Martijn
Martijn

Reputation: 65

vba powerpoint: change multiple shapes using the same 'with'

I have a macro in which I create two boxes, one at the tope of the slide and one at the bottom: oBoxTop and oBoxBottom.

Currently I have something like this:

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

Since both boxes have to be formatted the same way I was hoping to do it with just a single block of code rather than repeating everything, even if it's only to compress the code a bit.

Since there are other shapes on the slide that do not need to be changed (only the two just created need to change) I was trying something like

With oBoxTop & oBoxBottom

or

With oBoxTop and oBoxBottom

None of the options I tried have worked. Is there any way I can use the 'with function' for multiple shapes? Or do I have to do it completely differently?

Upvotes: 1

Views: 699

Answers (2)

TinMan
TinMan

Reputation: 7759

Passing an Array() of names to the Shapes.Range() allows you to work on multiple Shapes at one time.

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

Upvotes: 0

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19712

To expand on my comment of passing the shape reference to another procedure.

I haven't tested, but it should look something like this: 

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

You can then call this procedure and pass it different shapes: 

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

Edit: I've updated the procedure name - PositionShape is misleading. I really should read the question properly first. :)

Upvotes: 2

Related Questions