Including text boxes in find/replace macro

[Harry88]

I have a set of macros that finds specfied characters and prompts the user to replace them with other specified characters; e.g., this one.

Sub ConvertMicronSymbolInNormalFontToGreekLetterMuInSymbolFont()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim lAsk As Long

    vFindText = Array(Chr(181))
    vReplaceText = Array(-3987)
    j = 0: k = 0: m = 0
    For i = 0 To UBound(vFindText)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .Text = vFindText(i)
            Do While .Execute
                j = j + 1
                oRng.Select
                lAsk = MsgBox("Convert this character?", vbYesNoCancel)
                If lAsk = 2 Then GoTo lbl_Exit
                If lAsk = 6 Then
                    k = k + 1
                    oRng.InsertSymbol Font:="Symbol", _
                                      CharacterNumber:=vReplaceText(i), _
                                      Unicode:=True
                Else
                    m = m + 1
                End If
                oRng.Collapse 0
            Loop
        End With
    Next i
lbl_Exit:
    If j = 0 Then MsgBox "No matches found.", vbInformation
    If k > 0 Or m > 0 Then MsgBox k & " matches converted." & vbCr & _
       m & " matches skipped.", vbInformation
    Exit Sub
End Sub

The macro works fine, but if a document contains any text boxes, the macro doesn't include them. How can I get the macro to include text boxes?

[gmayor]

There are 11 story ranges in a document. You need to loop through them and set the search range appropriately. This is a lot more complicated than the original.
The following should work.

Sub ConvertMicronSymbolInNormalFontToGreekLetterMuInSymbolFont()
'Graham Mayor - https://www.gmayor.com - Last updated - 21 Mar 2023
Dim rngStory As Word.Range
Dim oShp As Shape
Dim sCollect As String
Dim iJ As Double, iK As Double, iM As Double
    iJ = 0: iK = 0: iM = 0

    For Each rngStory In ActiveDocument.StoryRanges
        Select Case rngStory.StoryType
            Case 1 To 11
                Do
                    sCollect = SrcAndRplInStory(rngStory)
                    iJ = iJ + Val(Split(sCollect, "|")(0))
                    iK = iK + Val(Split(sCollect, "|")(1))
                    iM = iM + Val(Split(sCollect, "|")(2))
                    On Error Resume Next
                    DoEvents

                    On Error GoTo 0
                    Select Case rngStory.StoryType
                        Case 6, 7, 8, 9, 10, 11
                            If rngStory.ShapeRange.Count > 0 Then
                                For Each oShp In rngStory.ShapeRange
                                    If oShp.TextFrame.HasText Then
                                        sCollect = SrcAndRplInStory(oShp.TextFrame.TextRange)
                                        iJ = iJ + Val(Split(sCollect, "|")(0))
                                        iK = iK + Val(Split(sCollect, "|")(1))
                                        iM = iM + Val(Split(sCollect, "|")(2))
                                    End If
                                    DoEvents
                                Next oShp
                            End If
                        Case Else
                            'Do Nothing
                    End Select
                    On Error GoTo 0
                    'Get next linked story (if any)
                    Set rngStory = rngStory.NextStoryRange
                Loop Until rngStory Is Nothing
            Case Else
        End Select
        DoEvents
    Next rngStory
lbl_Exit:
    If iJ = 0 Then MsgBox "No matches found.", vbInformation
    If iK > 0 Or iM > 0 Then MsgBox iK & " matches converted." & vbCr & _
       iM & " matches skipped.", vbInformation

    Set rngStory = Nothing
    Set oShp = Nothing
    Exit Sub
err_Handler:
    Resume lbl_Exit
End Sub

Private Function SrcAndRplInStory(oRng As Range) As String
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim lAsk As Long

    vFindText = Array(Chr(181))
    vReplaceText = Array(-3987)
    j = 0: k = 0: m = 0
    For i = 0 To UBound(vFindText)
        With oRng.Find
            .Text = vFindText(i)
            Do While .Execute
                j = j + 1
                oRng.Select
                lAsk = MsgBox("Convert this character?", vbYesNoCancel)
                If lAsk = 2 Then GoTo lbl_Exit
                If lAsk = 6 Then
                    k = k + 1
                    oRng.InsertSymbol Font:="Symbol", _
                                      CharacterNumber:=vReplaceText(i), _
                                      Unicode:=True
                Else
                    m = m + 1
                End If
                oRng.Collapse 0
            Loop
        End With
    Next i
lbl_Exit:
    SrcAndRplInStory = j & "|" & k & "|" & m
    Exit Function
End Function

[Harry88]

That works fine thanks, with the following tweaks to the private function as discussed offline.

Private Function SrcAndRplInStory(oRng As Range) As String
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim lAsk As Long


    vFindText = Array(Chr(181))
    vReplaceText = Array(-3987)
    j = 0: k = 0: m = 0
    For i = 0 To UBound(vFindText)
        With oRng.Find
            .Clear.Formatting
            .Replacement.Clear.Formatting
            .Text = vFindText(i)
            .Wrap = wdFindContinue
            Do While .Execute
                j = j + 1
                oRng.Select
                lAsk = MsgBox("Convert this character?", vbYesNoCancel)
                If lAsk = 2 Then GoTo lbl_Exit
                If lAsk = 6 Then
                    k = k + 1
                    oRng.InsertSymbol Font:="Symbol", _
                                      CharacterNumber:=vReplaceText(i), _
                                      Unicode:=True
                Else
                    m = m + 1
                End If
                'oRng.Collapse 0
            Loop
        End With
    Next i
lbl_Exit:
    SrcAndRplInStory = j & "|" & k & "|" & m
    Exit Function
End Function