Find routines VBA examples

OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

Locate specific text and format the shape containing it.

Download sample demo:

' ---------------------------------------------------------------------
' Copyright ©1999-2018, 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.
' ---------------------------------------------------------------------

' 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:

' 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