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

【问题标题】：How can i change every occurence of a specific font ind a Word document?如何更改 Word 文档中每次出现的特定字体？
【发布时间】：2019-08-15 15:01:40
【问题描述】：

我有以下问题。我目前正在创建一个宏来获取 Word 文档中使用的所有字体。之后它会检查是否安装了此字体并将字体更改为预定义的字体。（因为 Word 中的 Microsoft 自动字体更改非常糟糕，并且会将我的字体更改为 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，但根本无法让它工作。

【问题讨论】：

您使用了完全错误的方法。检查文档样式。如果样式不使用您可以接受的字体，则将该样式字体更改为可以接受的字体。这将捕获文档中出现的每一个文本。
@freeflow 我正在编写的脚本用于 Web 应用程序，在该应用程序中，我无法确定加载的文档中出现的每个文本都采用 word 样式设置样式。某些文本（例如 adressfield 等）有时会在不使用 Word 样式的情况下松散地设置样式。据我了解，document.styles 只会查看这些预设样式。为了确保我真的得到每一次出现，我宁愿遍历字符/段落或其他任何东西而不是样式。如果我错了，请纠正我！（也许给我一个提示，因为我对 VBA 还很陌生）提前谢谢！
原始问题中没有提到。您应该更新您的问题以准确指定您工作的环境。
对不起，我现在将其标记为答案。我忘了它羞耻

标签： vba fonts ms-word

【解决方案1】：

不清楚“文本字段”是什么意思，因为它可能是 Word 中五六种不同的东西中的任何一种......

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

以下代码示例演示了如何循环文档中的所有“故事”。我已将问题中提供的代码放在从“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

【讨论】：