Search code examples
vbams-wordformatting

Replace a certain format with a different format using Word VBA


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.


Solution

    • You don't need to use Do While. ReplaceAll is more efficient.
    • rng.ClearFormatting should be .Replacement.ClearFormatting.

    Microsoft documentation:

    Replacement.ClearFormatting method (Word)

    Find.ClearFormatting method (Word)

    Font.AllCaps property (Word)

    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