Consulting

Results 1 to 3 of 3

Thread: PPT VBA Help: Change Picture Shape and Position Based on Text Find Results

  1. #1
    VBAX Regular
    Joined
    Jun 2019
    Posts
    44
    Location

    PPT VBA Help: Change Picture Shape and Position Based on Text Find Results

    Good morning all! Is there a way to search for specific text in one slide, and based on whether or not it finds something, it runs a macro?

    My example:
    When I create my reports, if the first slide has the specific "Name" in any TextBox/TextPlaceHoler, then Slide 4 has to have a specific picture size and position. I tried using the code below, but keep getting an error:
    Run-time error '91':
    Object variable or With block variable not set

    Dim oSld As SlideDim oShp As Shape
    Set oSld = ActivePresentation.Slides(1)
    For Each oShp In oSld.Shapes
    If oShp.HasTextFrame Then
    If oShp.TextFrame.TextRange.Find("Name") Then
    'Nothing found
    Else
    'Found text
    For Each opic In ActivePresentation.Slides(4).Shapes
    If opic.Type = msoPicture Then
    With opic
    .LockAspectRatio = msoFalse
    .Height = 306.72
    .Width = 195.12
    .Left = 409.68
    .Top = 40.32
    .ZOrder (msoSendBackward)
    .Line.Weight = 1
    .Line.ForeColor.RGB = RGB(99, 102, 106)
    End With
    Else
    End If
    Next opic
    Exit Sub
    End If
    End If
    Next oShp
    Thanks a lot!

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,868
    Location
    Here you go

    Sub chex()
    Dim oSld As Slide
    Dim oShp As Shape
    Dim opic As Shape
    Dim b_found As Boolean
    Set oSld = ActivePresentation.Slides(1)
    
    
    For Each oShp In oSld.Shapes
    If oShp.HasTextFrame Then
    If InStr(oShp.TextFrame.TextRange, "Name") = 0 Then
    'Nothing found
    Else
    b_found = True
    Exit For
    End If
    End If
    Next oShp
    
    
    'Found text
    If b_found = True Then
    For Each opic In ActivePresentation.Slides(4).Shapes
    If opic.Type = msoPicture Then
    With opic
    .LockAspectRatio = msoFalse
    .Height = 306.72
    .Width = 195.12
    .Left = 409.68
    .Top = 40.32
    .ZOrder (msoSendBackward)
    .Line.Weight = 1
    .Line.ForeColor.RGB = RGB(99, 102, 106)
    End With
    Else
    End If
    Next opic
    End If
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Regular
    Joined
    Jun 2019
    Posts
    44
    Location
    Beautiful, worked like a charm, thanks John!

Tags for this Thread

Posting Permissions

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