How can i change every occurence of a specific font ind a Word document?

Question

i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).

Everything works as intended except for one thing.

This here is the code i am using to exchange every occurence of the found font in the document:

For i = 0 To UBound(missingFont)
    For Each oCharacter In ActiveDocument.Range.Characters
        If oCharacter.Font.name = missingFont(i) Then
            oCharacter.Font.name = fontToUse
            If InStr(missingFont(i), "bold") Then
                oCharacter.Font.Bold = True
            End If
            If InStr(missingFont(i), "italic") Then
                oCharacter.Font.Italic = True
            End If
        End If
    Next oCharacter
Next i

So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?

First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.

You are using a completely wrong approach. Check the document styles. If the style does not use a font that is acceptable to you then change that style font to one that is. This will catch every ocurrence of text in your document. — freeflow
@freeflow The script im writing is used in a web-application where i cant be certain that every text occurence in a loaded document is styled by a word style. Some texts (for example adressfield and such) are sometimes styled loosely without using the Word Styles. As far as i understand it, the document.styles would only look at these preset styles. To make sure that i actually get every occurence i'd rather loop through the characters/ paragraphs or whatever than the styles. Correct me if im wrong please! (and maybe give a hint how to do so as im fairly new to VBA) Thanks in advance! — Grim
That's not mentioned in your original question. You should update your question to specify exactly the environment in which you are working. — freeflow
im sorry, ive marked its a the answer now. I forgot about it shame — Grim

Cindy Meister Cindy Meister · Accepted Answer · 2019-08-16T09:55:48

It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...

But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.

The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)

Sub ProcessAllStories()
    Dim doc as Word.Document
    Dim missingFont as Variant
    Dim myStoryRange as Word.StoryRange

    'Define missingFont
    Set doc = ActiveDocument
    For Each myStoryRange In doc.StoryRanges
        CheckFonts myStoryRange, missingFont
        Do While Not (myStoryRange.NextStoryRange Is Nothing)
            Set myStoryRange = myStoryRange.NextStoryRange
            CheckFonts myStoryRange, missingFont
        Loop
    Next myStoryRange
End Sub

Sub CheckFonts(rng as Word.Range, missingFont as Variant)
    Dim oCharacter as Word.Range

    For i = 0 To UBound(missingFont)
        For Each oCharacter In rng.Characters
            If oCharacter.Font.name = missingFont(i) Then
                oCharacter.Font.name = fontToUse
                If InStr(missingFont(i), "bold") Then
                    oCharacter.Font.Bold = True
                End If
                If InStr(missingFont(i), "italic") Then
                    oCharacter.Font.Italic = True
                End If
            End If
        Next oCharacter
    Next i
End Sub

How can i change every occurence of a specific font ind a Word document?

1 Answers