VBA 学习笔记 Word样式处理

╰+攻爆jí腚メ 2022-10-07 01:56 626阅读 0赞

### 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][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 (枚举)][WORD _ WDSTYLETYPE]

<table> 
 <thead> 
  <tr> 
   <th>名称</th> 
   <th>值</th> 
   <th>说明</th> 
  </tr> 
 </thead> 
 <tbody> 
  <tr> 
   <td>wdStyleTypeCharacter</td> 
   <td>2</td> 
   <td>正文字符样式。</td> 
  </tr> 
  <tr> 
   <td>wdStyleTypeList</td> 
   <td>4</td> 
   <td>列表样式。</td> 
  </tr> 
  <tr> 
   <td>wdStyleTypeParagraph</td> 
   <td>1</td> 
   <td>段落样式。</td> 
  </tr> 
  <tr> 
   <td>wdStyleTypeTable</td> 
   <td>3</td> 
   <td>表格样式。</td> 
  </tr> 
 </tbody> 
</table>

# 参考资料 #

[微软Docs 》Office 》VBA 》参考 》Word 》对象模型 》Style ][Docs _Office _VBA _ _Word _ _Style]

[https_zhuanlan.zhihu.com_p_306579510]: https://zhuanlan.zhihu.com/p/306579510
[WORD _ WDSTYLETYPE]: https://docs.microsoft.com/zh-cn/office/vba/api/word.wdstyletype
[Docs _Office _VBA _ _Word _ _Style]: https://docs.microsoft.com/zh-cn/office/vba/api/word.style