PDA

View Full Version : [SOLVED:] Looking for code that changes shape properties based on substring in Title?



ajjava
05-22-2019, 06:47 AM
I have a presentation that contains several slides. For any slide that contains a certain word in the slide title, I'd like to change the size/position properties of the rectangle that is also on that slide.

Can anyone help?

I'm currently trying to work with the instr function, but I'm getting odd results (probably because I'm guessing at a lot of the syntax). THANK YOU!!

John Wilson
05-22-2019, 08:21 AM
This sort of thing :


Sub change_rect()
Dim osld As Slide
Dim strText As String
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
strText = osld.Shapes.Title.TextFrame.TextRange.Text
If InStr(UCase(strText), "JOHN") > 0 Then
On Error Resume Next
osld.Shapes("Rectangle 4").Fill.ForeColor.RGB = vbRed
End If
End If
Next osld
End Sub

ajjava
05-22-2019, 08:48 AM
Ahhh, excellent. Can I substitute the "4" with a wildcard *, to reference the Rectangles?

John Wilson
05-22-2019, 09:13 AM
No the shape name has to be exact, but you could rename them all to (for example) "TargetShape" in the Selection Pane.

ajjava
05-22-2019, 09:35 AM
Wow, is that right? Is there no way to generically loop through and "act on" all shapes in a presentation, whether you know their names or not? In other words, is the lack of being able to do so specific to my situation, or does that same rule apply across the board?

BTW, the code you supplied works perfectly. I really feel like I may never fully sort this language out :( I trip myself up so easily.

John Wilson
05-22-2019, 11:07 AM
You can do this if you loop. It takes (very slightly ) longer to loop through shapes but you won't notice unless there are hundreds of shapes.

You problem will be the default name for rectangles is Rectangle x so wildcard may not be a good idea. You can easily act of all Rectangles though


Sub change_Allrect()
Dim osld As Slide
Dim oshp As Shape
Dim strText As String
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
strText = osld.Shapes.Title.TextFrame.TextRange.Text
If InStr(UCase(strText), "JOHN") > 0 Then
On Error Resume Next
For Each oshp In osld.Shapes
If oshp.Type = msoAutoShape Then
If oshp.AutoShapeType = msoShapeRectangle Then
oshp.Fill.ForeColor.RGB = vbRed
End If 'rectangle
End If 'autoshape
Next oshp
End If
End If
Next osld
End Sub

ajjava
05-22-2019, 11:23 AM
Thank you so much for your assistance. Invaluable.