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.

Thanks KazJaw. I really appreciate everyones help here on SO and will do that from now on. I went through my past answers and accepted the best answers. — Edward Armstrong, Oct 09 '13 at 15:32
See @SteveRindsberg's suggestion, I did not know this was possible, so the very complicated method I suggested is not necessary. I revised my answer to use Steve's suggestion, but he should probably get credit for the answer if it works for you. — David Zemens, Oct 10 '13 at 14:53

David Zemens · Accepted Answer · 2013-10-10T14:50:15.170

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.

enter image description here

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

I am getting an error on Characters in 'shp.textframe.Characters' when I try to replicate your code. Any advice on debugging? Any advice on what the functions are that you mentioned that will help me compute character width/etc.? Thanks so much for your detailed response. — Edward Armstrong, Oct 09 '13 at 17:26
I updated with some information about the functions you might be able to use. If this has been helpful, do consider upvoting or accepting the answer. Let me know if you have any more Q's to clarify :) — David Zemens, Oct 09 '13 at 18:01

score 3 · Answer 2 · answered Oct 09 '13 at 23:27

3

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

answered Oct 09 '13 at 23:27

Steve Rindsberg

14,442
1
29
34

+1 I learn something here every day! Hope you don't mind that I borrowed this idea and revised my answer. I saw the `.BoundTop` etc in the locals window but did not think to try and use it :) Brilliant. – David Zemens Oct 10 '13 at 14:50
Excel magic. Thanks a lot David and Steve for helping me through this one. I should've specified this in my question but the character arrows are usually in tables. Is there any way to customize it for that purpose? – Edward Armstrong Oct 10 '13 at 19:45
2

@David: Mind? Good heavens no. Especially not since you've run with it and solved Edward's problem with it. Nice work! Edward: you'd need to check oSh.HasTable to see if the shape is a table, then iterate through each oSh.Table.Cell(x,y).Shape.TextFrame.TextRange etc – Steve Rindsberg Oct 11 '13 at 01:08
@EdwardArmstrong tables are a little trickier but what Steve says is the way to approach it. – David Zemens Oct 11 '13 at 01:31
thanks guys. I have marked David's answer the correct one because he helped put it all together but I certainly wish I could select both! I am grateful to both of you! – Edward Armstrong Oct 11 '13 at 12:46
No problem, Edward. David did all the heavy lifting. I just stood off to one side yelling "A little more to the left!" – Steve Rindsberg Oct 11 '13 at 15:09

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

2 Answers2