Including text boxes in find/replace macro

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.

Code:

---

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?

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.

Code:

---

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

---

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

Code:

---

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

---