Powerpoint VBA: Search for an character Arrow and replace with a shape arrow

Question

What I need to be able to do is find a up arrow character and replace it with an up arrow shape and do the same thing for down arros. I am a novice to VBA but have an idea for how I want the Macro to work. It should loop through all slides on the powerpoint.

1) Find the location of the arrow character? (using the INSTR command? and the CHR code command. Not sure if INSTR works in ppt or is the appropriate code here)

2) Add shape with the location returned from the previous line of code. My code is below that already adds this shape to my specifications.

  Dim i As Integer
  Dim shp As Shape
  Dim sld As Slide
  Set sld = Application.ActiveWindow.View.Slide

  Set shp = sld.Shapes.AddShape(36, 10, 10, 5.0399, 8.6399)
  shp.Fill.ForeColor.RGB = RGB(89, 0, 0)
   shp.Fill.BackColor.RGB = RGB(89, 0, 0)
 shp.Line.ForeColor.RGB = RGB(89, 0, 0)

3) Find and delete all character arrows so the shapes are the only ones left behind.

I've been struggling my way through VBA in PPT and would appreciate any help you could give me.

Answer 1

You're on the right track. Assume I have a shape like this, where it has letters and also a special character, represented by the hex value &H25B2.

First, you need to identify what is the value of your character. There are lots of places where you can find these references.

Then, how to work with in your code, here is one example that finds the shape, and covers it with your arrow, revised per @SteveRindsberg's suggestion, below :)

Public Const upArrow As String = &H25B2     'This is the Hex code for the upward triangle/arrow
Public Const downArrow As String = &H25BC   'This is the Hex code for the downward triangle/arrow
Sub WorkWithSpecialChars()
    Dim pres As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim foundAt As Long
    Dim arrowTop As Double
    Dim arrowLeft As Double
    Dim arrow As Shape
    Set pres = ActivePresentation

    For Each sld In pres.Slides
       For Each shp In sld.Shapes
        If shp.HasTextFrame Then
           foundAt = InStr(shp.TextFrame.TextRange.Characters.Text, ChrW(upArrow))
           If foundAt > 0 Then
               MsgBox "Slide " & sld.SlideIndex & " Shape " & shp.Name & " contains " & _
                   "the character at position " & foundAt, vbInformation

                'Select the text
                With shp.TextFrame.TextRange.Characters(foundAt, 1)
                'Get the position of the selected text & add the arrow
                    Set arrow = sld.Shapes.AddShape(36, _
                            .BoundLeft, .BoundTop, .BoundWidth, .BoundHeight)
                    'additional code to format the shape
                    ' or call a subroutine to format the shape, etc.


                End With
           Else:
               Debug.Print "Not found in shape " & shp.Name & ", Slide " & sld.SlideIndex
           End If
        End If
       Next
    Next

End Sub

Answer 2

To add a bit to what David's done already, once you get a reference to a text range (pretty much any chunk of text), you can get the text's bounding box and use that to position your shape. Here's a start:

Sub testMe()
    Dim oSh As Shape
    Dim oRng As TextRange

    ' As an example, use the currently selected shape:
    Set oSh = ActiveWindow.Selection.ShapeRange(1)

    With oSh.TextFrame.TextRange
        ' Does it contain the character we're looking for?
        If InStr(.Text, "N") > 0 Then
            ' Get a range representing that character
            Set oRng = .Characters(InStr(.Text, "N"), 1)
            ' And tell us the top
            Debug.Print TopOf(oRng)
            ' And as an exercise for the reader, do companion
            ' BottomOf, LeftOf, WidthOf functions below
            ' then use them here to position/size the shape
            ' atop the existing character
        End If
    End With

End Sub
Function TopOf(oRng As TextRange)
    TopOf = oRng.BoundTop
End Function