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
相关推荐
玩泥巴的1 天前
.NET驾驭Word之力:理解Word对象模型核心 (Application, Document, Range)
word·二次开发·office·com互操作
玩泥巴的2 天前
.NET驾驭Word之力:COM组件二次开发全攻略之连接Word与创建你的第一个自动化文档
word·二次开发·com互操作
辣香牛肉面3 天前
[Windows] 搜索文本2.6.2(从word、wps、excel、pdf和txt文件中查找文本的工具)
word·excel·wps·搜索文本
FlYFlOWERANDLEAF4 天前
DevExpress中Word Processing Document API学习记录
学习·c#·word
AnySpaceOne4 天前
PDF转Word在线转换教程:多种实用方法分享
学习·pdf·word
我命由我123456 天前
Word - Word 的 5 种视图(页面视图、阅读视图、Web 版式视图、大纲视图、草稿视图)
ui·word·excel·photoshop·表格·ps·美工
XYZLHL6 天前
Word怎么设置页码总页数不包含封面和目录页
word
传而习乎6 天前
Word添加图/表题注
word
YAY_tyy6 天前
基于 Vue3 + VueOffice 的多格式文档预览组件实现(支持 PDF/Word/Excel/PPT)
前端·javascript·vue.js·pdf·word·excel