如何更改 Word 文档中特定字体的每次出现？

Question

我有以下问题。我目前正在创建一个宏来获取 Word 文档中使用的每种字体。之后它会检查是否安装了此字体并将字体更改为预定义字体。（因为微软在 Word 中的自动字体更改非常糟糕，并将我的字体更改为 Comic Sans（不是开玩笑......）。

除一件事外，一切都按预期工作。

这是我用来交换每一次发现的代码文档中的字体：

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

基本上我会检查文档中的每个字符，并在需要时进行更改。现在这只适用于不在文本字段、页眉或页脚内的字符。我如何检查文档中的每一个字符？

首先我尝试使用 ActiveDocument.Range.Paragraphs 而不是 ActiveDocument.Range.Characters。我也尝试过使用此处给出的宏：http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro 但根本无法正常工作。

Answer 1

不清楚 "textfield" 是什么意思，因为它可能是 Word 中五六个不同的东西中的任何一个...

但是有一种方法可以访问几乎 Word 文档中的所有内容（不包括 ActiveX 控件），方法是循环所有 StoryRanges。 StoryRange 包括文档的主体、页眉、页脚、脚注、Shapes 中的文本范围等。

下面的代码示例演示了如何循环文档中的所有 "Stories"。我已将问题中提供的代码放在从 "Stories" 循环调用的单独过程中。（请注意，我无法测试，无法访问问题中使用的文档或代码的相关部分。）

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

如何更改 Word 文档中特定字体的每次出现？

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

fonts

vba

ms-word