In a large Word document I want to find instances of text formatted in the All Caps font (i.e. the underlying characters are lower case, they are just shown upper case) and convert these to upper case characters.
With the help of ChatGPT the following script runs, but does not go into the loop:
Sub ConvertToAllCaps()
Dim rng As Range
Dim doc As Document
' Set the document object
Set doc = ActiveDocument
' Set the range to search in the entire document
Set rng = doc.Content
With rng.Find
' Set the find parameters
.Font.AllCaps = True
' Execute the find operation
Do While .Execute
' Clear formatting before converting to all caps
rng.ClearFormatting
' Convert the found text to all caps
rng.Case = wdUpperCase
Loop
End With
End Sub
This code stops after the first successful conversion, i.e. it finds the first x connected bits of text that are formatted in all caps but then stops searching.
I played around with suggestions by others with a similar problem I could find on the internet.
The closest I got, inspired by this :
Sub ConvertToAllCaps()
Dim rng As Range
Dim doc As Document
Dim bFound As Boolean
bFound = True
' Set the document object
Set doc = ActiveDocument
' Set the range to search in the entire document
Set rng = doc.Content
rng.Find.ClearFormatting
Do While bFound
With rng.Find
' Set the find parameters
.Font.AllCaps = True
rng.ClearFormatting
rng.Case = wdUpperCase
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
bFound = .Execute
End With
Loop
End Sub
This made Word crash, so I know it went into the loop.
Do While
. ReplaceAll
is more efficient.rng.ClearFormatting
should be .Replacement.ClearFormatting
.Microsoft documentation:
Sub ReplaceAllCap()
With Selection.Find
.ClearFormatting
.Font.AllCaps = True
.Replacement.ClearFormatting
.Replacement.Font.AllCaps = False
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Execute Replace:=wdReplaceAll
End With
End Sub
Update:
Question: but now I notice it doesn't convert the text to upper case.
Sub ReplaceAllCap()
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Font.AllCaps = True
.Replacement.ClearFormatting
.Replacement.Font.AllCaps = False
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
Do While .Execute
Selection.Range.Case = wdUpperCase
Selection.Collapse Word.wdCollapseEnd
Loop
End With
End Sub