Find and Highlight Text in MS PowerPoint

Question

I used some code from this site to make a macro to do a keyword search on Word docs and highlight the results.

I would like to replicate the effect in PowerPoint.

Here is my code for Word.

Sub HighlightKeywords()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for

For i = 0 To UBound(TargetList) ' for the length of the array

   Set range = ActiveDocument.range

   With range.Find ' find text withing the range "active document"
   .Text = TargetList(i) ' that has the words from the array TargetList
   .Format = True ' with the same format
   .MatchCase = False ' and is case insensitive
   .MatchWholeWord = True ' and is not part of a larger word
   .MatchAllWordForms = False ' and DO NOT search for all permutations of the word

   Do While .Execute(Forward:=True)
   range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow

   Loop

   End With
Next

End Sub

Here is what I have so far in PowerPoint, it is in no way functional.

Sub HighlightKeywords()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for

For Each sld In Application.ActivePresentation.Slides

For Each shp In sld.Shapes

    If shp.HasTextFrame Then

        Set txtRng = shp.TextFrame.TextRange

For i = 0 To UBound(TargetList) ' for the length of the array

   With range.txtRng ' find text withing the range "shape, text frame, text range"
   .Text = TargetList(i) ' that has the words from the array TargetList
   .Format = True ' with the same format
   .MatchCase = False ' and is case insensitive
   .MatchWholeWord = True ' and is not part of a larger word
   .MatchAllWordForms = False ' and DO NOT search for all permutations of the word

   Do While .Execute(Forward:=True)
   range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow

   Loop

   End With
Next

End Sub

I ended up finding my answer through the MSDN, but it was very close to the answer I selected as correct from what people submitted.

Here is the code I went with:

Sub Keywords()

Dim TargetList
Dim element As Variant

TargetList = Array("First", "Second", "Third", "Etc")

For Each element In TargetList
   For Each sld In Application.ActivePresentation.Slides
      For Each shp In sld.Shapes
         If shp.HasTextFrame Then
            Set txtRng = shp.TextFrame.TextRange
            Set foundText = txtRng.Find(FindWhat:=element, MatchCase:=False, WholeWords:=True)
            Do While Not (foundText Is Nothing)
               With foundText
                  .Font.Bold = True
                  .Font.Color.RGB = RGB(255, 0, 0)
               End With
            Loop
         End If
      Next
   Next
Next element

End Sub

Turns out that code worked, but was a performance nightmare. The code I selected as the correct answer below runs much more smoothly. I've adjusted my program to match the answer selected.

score 2 · Accepted Answer · answered Apr 06 '13 at 06:26

AFAIK there is no inbuilt way to highlight the found word with a color. You could go out of the way to create a rectangular shape and place it behind the found text and color it but that is a different ball game altogether.

Here is an example which will search for the text in all slides and then make the found text BOLD, UNDERLINE and ITALICIZED. If you want you can also change the color of the font.

Let's say we have a slide which looks like this

enter image description here

Paste this code in a module and then try it. I have commented the code so that you will not have a problem understanding it.

Option Explicit

Sub HighlightKeywords()
    Dim sld As Slide
    Dim shp As Shape
    Dim txtRng As TextRange, rngFound As TextRange
    Dim i As Long, n As Long
    Dim TargetList

    '~~>  Array of terms to search for
    TargetList = Array("keyword", "second", "third", "etc")

    '~~> Loop through each slide
    For Each sld In Application.ActivePresentation.Slides
        '~~> Loop through each shape
        For Each shp In sld.Shapes
            '~~> Check if it has text
            If shp.HasTextFrame Then
                Set txtRng = shp.TextFrame.TextRange

                For i = 0 To UBound(TargetList)
                    '~~> Find the text
                    Set rngFound = txtRng.Find(TargetList(i))

                    '~~~> If found
                    Do While Not rngFound Is Nothing
                        '~~> Set the marker so that the next find starts from here
                        n = rngFound.Start + 1
                        '~~> Chnage attributes
                        With rngFound.Font
                            .Bold = msoTrue
                            .Underline = msoTrue
                            .Italic = msoTrue
                            '~~> Find Next instance
                            Set rngFound = txtRng.Find(TargetList(i), n)
                        End With
                    Loop
                Next
            End If
        Next
    Next
End Sub

Final Screenshot

enter image description here

That looks pretty close to what I came up with, so I think I'm on the right path. Thanks for the help! — Ryan Solis, Apr 07 '13 at 00:43
Wow, I wish I had the rep to give you another +1. I compiled your code just for fun and holy crap, it runs ten times as fast as mine. I guess that's the difference between your for loop that iterates through the list looking for each word in every text box nested and my iterative for loop searching the whole presentation for one word, then searching the whole presentation again for the next word. Thanks again, I learned a lot about efficiency through your example. -Ryan — Ryan Solis, Apr 07 '13 at 01:19
This is basically the approach I use, except what I found (in PowerPoint 2013, anyway) is that the Find() function does not necessarily return Nothing when no matches are found, and may return an empty TextRange object instead. This seems like a PowerPoint bug. Therefore, my workaround code is equivalent to Do While Not rngFound Is Nothing AndAlso rngFound.Length > 0. — OfficeAddinDev, Oct 05 '16 at 12:00

score 1 · Answer 2 · answered Apr 06 '13 at 09:55

1

I'd like to extend @Siddharth Rout answer which is good and rather recommended (awarder +1 from me). However, there is possibility to 'highlight' a word (range of words) in PP, too. There is one serious disadvantage of setting highlight- it destroys other font settings. Therefore, if one really need to use highlight than we need to return appropriate font settings afterwards.

Here is an example for single word in single text frame:

Sub Highlight_Word()

Dim startSize, startFont, startColor

With ActivePresentation.Slides(1).Shapes(1).TextFrame2.TextRange.Words(8).Font
'read current state
   startSize = .Size
   startFont = .Name
   startColor = .Fill.ForeColor.RGB

'set highlight
   .Highlight.RGB = RGB(223, 223, 223) 'light grey

'return standard parameters
   .Size = startSize
   .Name = startFont
   .Fill.ForeColor.RGB = startColor

End With

End Sub

That kind of solution could be placed somewhere inside of @Siddharth solution.

answered Apr 06 '13 at 09:55

Kazimierz Jawor

18,861
7
35
55

Good to know that highlighting is technically possible. Thank you for the input. – Ryan Solis Apr 07 '13 at 00:55
The ".Highlight.RGB =" line gave me this error: Compile error: Method or data member not found – Ryan Solis Apr 07 '13 at 01:44
Pretty sure you'd need to be running PPT 2010 (or maybe 2007) or higher to use .Highlight – Steve Rindsberg Apr 07 '13 at 03:17
+ 1 :) KJ. Yes there `IS` a possibility of highlighting text like I mentioned in my post but there is no INBUILT way like MS Word that I am aware of... – Siddharth Rout Apr 07 '13 at 07:34
@Ryan, @Steve, tested in PP2010 only. I need to admit that `.Highlight` is poorly described in PP help- use intuition when using :) – Kazimierz Jawor Apr 07 '13 at 08:45

score 0 · Answer 3 · answered Apr 06 '13 at 16:14

And if you need to preserve the original text formatting completely, you could:

On finding a shape that includes the target text, Duplicate the shape Send the duplicate to the original shape's Z-order Do the highlighting on the duplicate shape Apply tags to both the duplicate and original to indicate that they need attention later e.g. oOriginalShape.Tags.Add "Hilighting", "Original" oDupeShape.Tags.Add "Hilighting", "Duplicate"

Set the original shape invisible

Then if you need to reverse the highlighting and restore original formatting, you'd simply loop through all shapes; if the shape has a Hilighting tag = "Original", make it visible. If it has Higlighting tag = "Duplicate", delete it.

The hitch here is that if somebody's edited the highlighted shape, the edits will be lost when you revert. Users would have to be taught to revert, edit, then re=highlight.

Find and Highlight Text in MS PowerPoint

3 Answers3

Linked