VBA操作Word-慈云数据

检查word中的字体情况

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