检查word中的字体情况

Sub ListAllFontsInDocument()Dim doc As DocumentDim rng As RangeDim char As RangeDim fontName As StringDim uniqueFonts As Collection' 初始化集合用于存储唯一字体名称Set uniqueFonts = New Collection' 获取当前活动文档Set doc = ActiveDocument' 遍历文档中的每一个字符For Each rng In doc.Content.Characters' 获取字符的字体名称fontName = rng.Font.Name' 检查字体名称是否已经在集合中，如果没有则添加进去On Error Resume NextuniqueFonts.Add fontName, CStr(fontName)On Error GoTo 0Next rng' 输出所有唯一的字体名称Dim item As VariantFor Each item In uniqueFontsDebug.Print itemNext item
End Sub