如何用VBA提取Word中含特定样式格式单词的所有句子

问题说明 #

Word文档中有如下文本：

Lorem ipsum RED sit amet, consectetur adipiscing elit.

Ut enim BLUE ad minim veniam, quis nostrud exercitation ullamco.

Some line.

Another Line here.

其中RED和BLUE应用了名为COLOR的样式，需要提取包含这类样式单词的句子，但原有VBA代码无法正常运行。

原代码问题分析 #

1. 样式名错误：代码中myStyle = "Idioms"与实际需要的COLOR样式不匹配
2. Find对象设置错误：直接给.FormattedText.Style赋值不是搜索样式的正确方式，应该通过.Find.Style指定目标样式
3. 未关闭屏幕更新，运行时会频繁闪烁，影响效率

修正后的VBA代码 #

''+------------------------------------------------------------------+
''|                                                                  |
''|                                                                  |
''+------------------------------------------------------------------+
' 提取包含指定样式单词的句子
Sub A1ExtractCopy_STYLE()
    ' 指定要搜索的样式名称
    Dim myStyle As String: myStyle = "COLOR"
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    ' 当前文档的范围对象
    Dim r1 As Range: Set r1 = ActiveDocument.Range
    ' 新建文档用于存放提取的句子
    Dim NewDocument As Document: Set NewDocument = Documents.Add
    Dim r2 As Range: Set r2 = NewDocument.Range
    
    With r1.Find
        .ClearFormatting
        .Format = True
        ' 指定要搜索的样式
        .Style = ActiveDocument.Styles(myStyle)
        ' 执行搜索循环
        Do While .Execute
            ' 扩展范围到当前句子
            r1.Expand Unit:=wdSentence
            ' 将句子复制到新文档
            r2.Characters.Last.FormattedText = r1.FormattedText
            r2.InsertParagraphAfter
            ' 折叠范围到当前句子末尾，继续搜索下一个匹配项
            r1.Collapse wdCollapseEnd
        Loop
    End With
    
    ' 释放对象
    Set r1 = Nothing
    Set r2 = Nothing
    Set NewDocument = Nothing
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

关键修改点 #

• 修正样式名为COLOR，匹配实际需求
• 改用.Find.Style指定搜索样式，这是Word VBA中定位特定样式内容的标准写法
• 增加Application.ScreenUpdating = False关闭屏幕刷新，优化运行体验
• 补充ClearFormatting清除原有搜索格式，避免干扰后续匹配
• 增加对象释放代码，减少内存占用

使用说明 #

1. 打开目标Word文档
2. 按Alt + F11打开VBA编辑器
3. 插入模块，粘贴修正后的代码
4. 运行A1ExtractCopy_STYLE宏，会自动新建文档并提取符合条件的句子

内容的提问来源于stack exchange，提问作者Ziad El Hachem