Locate specific text and format the shape containing it.

Download sample demo:

' ---------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' ---------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' ---------------------------------------------------------------------

Option Explicit

' Searches for the specified text in all types of shapes
' and formats the box containing it.
' The shape reference is passed to pick up the formating
' of the desired shape for highlighting
Sub FindTextAndHighlightShape(SearchString As String, _
            oHighlightShape As Shape)
    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim oTmpRng As TextRange
    On Error Resume Next
    Set oSld = SlideShowWindows(1).View.Slide
    For Each oShp In oSld.Shapes
        ' I am looking for beveled autoshape since these contain the
        ' text and formatting and hence should be excluded from the
        ' search
        If oShp.Type = msoAutoShape Then
            If oShp.AutoShapeType = msoShapeBevel Then
                GoTo NextShape
            End If
        End If
        If oShp.HasTextFrame Then
            If oShp.TextFrame.HasText Then
                Set oTxtRng = oShp.TextFrame.TextRange
                Set oTmpRng = oTxtRng.Find(SearchString, , , True)
                If Not oTmpRng Is Nothing Then
                    oHighlightShape.PickUp
                    oShp.Apply
                Else
                    With oShp.Fill
                        .Visible = False
                        .Transparency = 0#
                    End With
                End If
            End If
        End If
NextShape:
    Next oShp
End Sub

' Assign this macro to the shapes containing the search text.
Sub ClickHere(oShp As Shape)
' oShp contains reference to the shape that was clicked
' to fire the macro.
' The text in the shape is passed to the search routine.
Call FindTextAndHighlightShape(oShp.TextFrame.TextRange.Text, oShp)
Call RefreshSlide
End Sub

Sub RefreshSlide()
On Error Resume Next
With SlideShowWindows(1).View
    .GotoSlide .CurrentShowPosition
End With
End Sub

Locate and highlight instances of a specific word

Download sample demo:

' ---------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' ---------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' ---------------------------------------------------------------------

Option Explicit

' Searches for the specified text in all types of shapes
' and highlights only the text.
' The TextRange is passed to apply the formatting
' of the text for highlighting
Sub FindTextAndHighlightShape(SearchString As String, _
        oHighlightTextRange As TextRange)
    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim oTmpRng As TextRange
    On Error Resume Next
    Set oSld = SlideShowWindows(1).View.Slide
    For Each oShp In oSld.Shapes
        ' I am looking for beveled autoshape since these contain the
        ' text and formatting and hence should be excluded from the
        ' search
        If oShp.Type = msoAutoShape Then
            If oShp.AutoShapeType = msoShapeBevel Then
                GoTo NextShape
            End If
        End If
        If oShp.HasTextFrame Then
            If oShp.TextFrame.HasText Then
                ' One needs to locate the text as well as iterate
                ' for multiple instances of the text
                Set oTxtRng = oShp.TextFrame.TextRange
                Set oTmpRng = oTxtRng.Find(SearchString, , , True)
                Do While Not oTmpRng Is Nothing
		' Highlight the text with the desired color	
                    oTmpRng.Font.Color = oHighlightTextRange.Font.Color
                    Set oTmpRng = oTxtRng.Find(SearchString, _
                            After:=oTmpRng.Start + oTmpRng.Length, _
                            WholeWords:=True)
                Loop
            End If
        End If
NextShape:
    Next oShp
End Sub

' Assign this macro to the shapes containing the search text.
Sub ClickHere(oShp As Shape)
' oShp contains reference to the shape that was clicked
' to fire the macro.
' The text in the shape is passed to the search routine.
' The text range contains the text formating to be applied
' while highlighting the found text.
    Call FindTextAndHighlightShape(oShp.TextFrame.TextRange.Text, _
            oShp.TextFrame.TextRange)
    Call RefreshSlide
End Sub

Sub RefreshSlide()
    On Error Resume Next
    With SlideShowWindows(1).View
        .GotoSlide .CurrentShowPosition
    End With
End Sub