VBA 学习笔记 Word样式处理

Posted 2021-12-28 笑虾

VBA 学习笔记 Word样式处理

• 移除样式并保留格式
• 删除用户自定义样式
• 删除未使用样式
• 判断样式是否存在
• 参考资料

移除样式并保留格式

Sub 移除样式并保留格式()
 '不能完全保留格式
 'https://sspai.com/post/38852
 '对于一个由多文档合并起来的长文档，它的样式多而混乱以致于无法使用，会引起word崩溃
 '对于这些样式，移除（即都统一为正文样式），并保留各种格式（变成不受样式控制的直接格式）
     Dim Para As Paragraph
     Dim Fnt As Font '代码字体的所有格式
     Dim Pfmt As ParagraphFormat '代表段落的所有格式
     For Each Para In ActiveDocument.Paragraphs
         With Para
             If .Style <> ActiveDocument.Styles("正文") Then '如果不是正文样式，则开始处理
                Set Fnt = .Style.Font '获得段落样式的所有字体属性，赋给fnt
                Set Pfmt = .Style.ParagraphFormat '获得段落样式的所有段落属性，赋给pfmt
                .Style = ActiveDocument.Styles("正文") '把它的样式改为正文
                .Range.Font = Fnt '为改变样式后的段落设置回原来的字体属性
                .Range.ParagraphFormat = Pfmt '为改变样式后的段落设置回原来的段落属性
             End If
         End With
     Next
 End Sub

删除用户自定义样式

Sub DeleteUserStyles()
    ' 报错时直接忽略，继续执行后续代码
    On Error Resume Next

    Dim oStyle As Style, count
    count = 0
    
    For Each oStyle In ActiveDocument.Styles
        ' 只检查用户自定义样式
        If oStyle.BuiltIn = False Then
               
            oStyle.Delete
            count = count + 1
        End If
    Next oStyle
    
    MsgBox "共删除【" & count & "】个未使用样式"
    
End Sub

删除未使用样式

Sub DeleteUnusedStyles()
    ' 报错时直接忽略，继续执行后续代码
    On Error Resume Next

    Dim oStyle As Style, count
    count = 0
    
    For Each oStyle In ActiveDocument.Styles
        ' 只检查用户自定义样式
        If oStyle.BuiltIn = False Then
            With ActiveDocument.Content.Find
                .ClearFormatting ' 在搜索选定内容之前从查找条件中取消格式限定
                .Style = CVar(oStyle.NameLocal) ' 返回指定对象的样式
                .Execute FindText:="", Format:=True ' FindText 目标文本，""仅搜索格式; Format 找格式而非文本。
                 If .Found = False Then
                    oStyle.Delete
                    count = count + 1
                End If
            End With
        End If
    Next oStyle
    
    MsgBox "共删除【" & count & "】个未使用样式"
    
End Sub

别一个版本来源于：https://zhuanlan.zhihu.com/p/306579510

Sub 删除未使用样式organizerdelete()
'https://word.tips.net/T001337_Removing_Unused_Styles.html

On Error GoTo ErrorHandler
Dim oStyle As Style, i&
i = 0
For Each oStyle In ActiveDocument.Styles
	' 只检查用户自定义样式
    If oStyle.BuiltIn = False Then
        With ActiveDocument.Content.Find
            .ClearFormatting
            .MatchWildcards = False
            .Style = CVar(oStyle.NameLocal)
            .Execute FindText:="", Format:=True
            If Not .Found Then
                Application.OrganizerDelete _
                Source:=ActiveDocument.Path & "\\" & ActiveDocument.Name, _
                Name:=oStyle.NameLocal, Object:=wdOrganizerObjectStyles
                i = i + 1
            End If
        End With
    End If
Next oStyle
MsgBox "共删除" & i & "未使用样式"

Exit Sub '退出过程

'发生错误时处理
ErrorHandler:
    i = i - 1 '发生一次错误则减1
    Resume Next

End Sub

判断样式是否存在

Sub checkStyle()
      
    Dim styleName As String '声明字符串
    styleName = "图片"      '赋值
    
    If styleIsExists(ThisDocument, styleName) Then
        ThisDocument.Styles(styleName).Delete
        MsgBox "文档【" & ThisDocument.Name & "】存在【" & styleName & "】样式" & vbCr & "已自动删除！", 64, "检测样式是否存在？"
    Else
        Set myStyle = ActiveDocument.Styles.Add(Name:=styleName, Type:=wdStyleTypeParagraph)
        MsgBox "文档【" & ThisDocument.Name & "】不存在【" & styleName & "】样式" & vbCr & "已自动创建！", 16, "检测样式是否存在？"
    End If
    
End Sub

' 判断样式是否存在
Function styleIsExists(myDocument As Word.Document, styleName As String) As Boolean

    On Error Resume Next
    styleIsExists = myDocument.Styles(styleName).NameLocal = styleName
    
End Function

• WORD 中的 WDSTYLETYPE (枚举)

名称	值	说明
wdStyleTypeCharacter	2	正文字符样式。
wdStyleTypeList	4	列表样式。
wdStyleTypeParagraph	1	段落样式。
wdStyleTypeTable	3	表格样式。

参考资料

微软Docs 》Office 》VBA 》参考 》Word 》对象模型 》Style