VBA操作Word

检查word中的字体情况

vbnet 复制代码
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

删除未使用样式

vbnet 复制代码
Sub 删除文档中未使用的样式()
    Dim doc As Document
    Dim pa As Paragraph
    Dim i As Long
    Dim sty As Style
    Dim dSty As Object
    Dim key
    
    Set dSty = CreateObject("Scripting.Dictionary")
    
    Set doc = ActiveDocument
    
    For Each pa In doc.Paragraphs
        key = pa.Style.NameLocal
        
        Debug.Print key
        If Not dSty.Exists(key) Then
            dSty(key) = True
        End If
    Next pa
    
    For i = doc.Styles.Count To 1 Step -1
        Set sty = doc.Styles(i)
        key = sty.NameLocal
        
        If Not dSty.Exists(key) Then
            On Error Resume Next
            sty.Delete
            On Error GoTo 0
        End If
    Next i
    
    Set doc = Nothing
    Set pa = Nothing
    Set sty = Nothing
    
    MsgBox "完成"
End Sub

选中所有表格

vbnet 复制代码
Sub 选择word中的表格()
Dim t As Table
an = MsgBox("即将选择选区内所有表格,若无选区,则选择全文表格。", vbYesNo, "提示")
If an - 6 Then Exit Sub
Set rg = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
For Each t In rg.Tables
    t.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges wdEditorEveryone
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
End Sub
vbnet 复制代码
 ' 移除正则匹配的字符串中的指定字符
Public Sub RemoveChars()
    Dim rng As Range
    Set rng = ActiveDocument.Content ' 或者指定特定的Range对象

    With rng.Find
        .ClearFormatting
        .Text = "[A-Z][-][0-9]?{1,10}[。]"
        .Forward = True
        .MatchWildcards = True

        Do While .Execute
            Dim matchText As String
            matchText = rng.Text

            ' 去除matchText中的"x"字符
            matchText = Replace(matchText, "。", "")

            ' 将修改后的文本替换回原文档
            rng.Text = matchText

            ' 移动查找范围到下一个匹配项
            rng.Collapse wdCollapseEnd
        Loop
    End With
End Sub
相关推荐
我命由我123458 小时前
Word - Word 的 5 种视图(页面视图、阅读视图、Web 版式视图、大纲视图、草稿视图)
ui·word·excel·photoshop·表格·ps·美工
XYZLHL8 小时前
Word怎么设置页码总页数不包含封面和目录页
word
传而习乎8 小时前
Word添加图/表题注
word
YAY_tyy8 小时前
基于 Vue3 + VueOffice 的多格式文档预览组件实现(支持 PDF/Word/Excel/PPT)
前端·javascript·vue.js·pdf·word·excel
东风西巷21 小时前
Atlantis Word Processor:全方位的文字处理专家
前端·学习·word·软件需求
Metaphor6921 天前
Java 高效处理 Word 文档:查找并替换文本的全面指南
java·经验分享·word
jianghaha20112 天前
前端 Word 模板参入特定数据 并且下载
前端·word
揭老师高效办公2 天前
在Word和WPS文字中便捷切换英文段落大小写
word·wps文字
CodeCraft Studio2 天前
国产化Word处理组件Spire.DOC教程:使用 Python 将 Markdown 转换为 HTML 的详细教程
python·html·word·markdown·国产化·spire.doc·文档格式转换