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