Consulting

Results 1 to 7 of 7

Thread: Looking for code that changes shape properties based on substring in Title?

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location

    Looking for code that changes shape properties based on substring in Title?

    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!!

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    Ahhh, excellent. Can I substitute the "4" with a wildcard *, to reference the Rectangles?

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    No the shape name has to be exact, but you could rename them all to (for example) "TargetShape" in the Selection Pane.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  5. #5
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    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.

  6. #6
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  7. #7
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    Thank you so much for your assistance. Invaluable.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •