正则表达式 Microsoft Word 不会破坏文档格式

Question

众所周知，单词的查找和替换“通配符”功能受到一些严重的限制。

以下代码在 word 文档中实现了真正的正则表达式查找和替换，它的变体可在其他 Stackoverflow 和 SuperUser 问题中找到。

Sub RegEx_PlainText(Before As String, After As String)

    Dim regexp As Object
    Set regexp = CreateObject("vbscript.regexp")            

    With regexp
        .Pattern = Before
        .IgnoreCase = True
        .Global = True

         'could be any Range , .Range.Text , or selection object
         ActiveDocument.Range = .Replace(ActiveDocument.Range, After)

    End With
End Sub

但是，这会擦除所有格式的文档。

即使字符串长度相同或实际上是相同的字符串，Word 也不会逐个字符地保留格式，因此ActiveDocument.Range = ActiveDocument.Range 或Selection.Text=Selection.Text 将擦除所有格式（或更准确地说，将整个范围的格式设置为与范围内的第一个字符，并添加回车）。仔细想想，这种行为并不令人惊讶。

为了解决这个问题，以下代码运行正则表达式查找，然后循环遍历匹配项并仅在找到匹配项的范围内运行 .replace。 这样，只有在以下情况下才会丢失格式匹配本身有多种格式（例如，斜体字会丢失）

希望代码 cmets 使这变得非常透明。

Sub RegEx(Before As String, After As String, _
          Optional CaseSensitive As Boolean = False, _
          Optional Location As Range = Nothing, _
          Optional DebugMode As Boolean = False)

    'can't declare activedocument.range in parameters
    If Location Is Nothing Then Set Location = ActiveDocument.Range

    Dim regexp As Object
    Dim Foundmatches As Object
    Dim Match As Object
    Dim MatchRange As Range
    Dim offset As Integer: offset = 0
    Set regexp = CreateObject("vbscript.regexp")

   With regexp
        .Pattern = Before
        .IgnoreCase = Not CaseSensitive
        .Global = True

        'set foundmatches to collection of all regex matches
        Set Foundmatches = .Execute(Location.text)

        For Each Match In Foundmatches

            'set matchrange to location of found string in source doc.
            'offset accounts for change in length of  document from already completed replacements
            Set MatchRange = Location.Document _
                   .Range(Match.FirstIndex + offset, _
                          Match.FirstIndex + Match.Length + offset)

            'debugging
            If DebugMode Then
                    Debug.Print "strfound      = " & Match.Value
                    Debug.Print "matchpoint    = " & Match.FirstIndex
                    Debug.Print "origstrlength = " & Match.Length
                    Debug.Print "offset        = " & offset
                    Debug.Print "matchrange    = " & MatchRange.text
                    MatchRange.Select
                Stop

            Else
            'REAL LIFE
                'run the regex replace just on the range containing the regex match
                MatchRange = .Replace(MatchRange, After)

                'increment offset to account for change in length of document
                offset = offset + MatchRange.End - MatchRange.Start - Match.Length
            End If
        Next
    End With
End Sub

这适用于简单的文档，但是当我在真实文档上运行它时，matchrange 最终会出现在找到匹配项的位置附近，但并不完全正确。 不是可以预见的是，有时它在右边，有时在左边。通常文档越复杂。 （链接、上下文表、格式等）越错误。

有谁知道为什么这不起作用，以及如何解决它？如果我能理解为什么这不起作用，那么我可能能够确定这种方法是否可以修复，或者如果我只需要尝试不同的方法。

代码包含 DebugMode 参数，这意味着它只会循环遍历文档并突出显示所有匹配项，不执行任何更改。 还会向控制台输出一堆内容。这应该对任何愿意和我一起解决这个问题的人有所帮助。

https://calibre-ebook.com/downloads/demos/demo.docx这是一个可能有用的示例文档（不是我制作的）。

Answer 1

@Some_Guy：感谢您提出这个问题，我遇到了类似的问题，您的帖子为我节省了很多时间。

这是我想出的组合：

Sub RegEx(Before As String, After As String, _
          Optional CaseSensitive As Boolean = False, _
          Optional Location As Range = Nothing, _
          Optional DebugMode As Boolean = False)

    'can't declare activedocument.range in parameters
    If Location Is Nothing Then Set Location = ActiveDocument.Range

    Dim j As Long
    Dim regexp As Object
    Dim Foundmatches As Object
    Dim Match As Object
    Dim MatchRange As Range
    Dim offset As Integer: offset = 0
    Set regexp = CreateObject("vbscript.regexp")

    With regexp
        .Pattern = Before
        .IgnoreCase = Not CaseSensitive
        .Global = True

        'set foundmatches to collection of all regex matches
        Set Foundmatches = .Execute(Location.Text)
        For j = Foundmatches.Count - 1 To 0 Step -1

            If DebugMode = True Then
                'debugging
                Debug.Print Foundmatches(j), .Replace(Foundmatches(j), After)
            Else
                'REAL LIFE

                'run a plain old find/replace on the found string and eplace strings
                With ActiveDocument.Range.Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    .Replacement.Font.Hidden = True
                    .Text = Foundmatches(j)
                    .Replacement.Text = regexp.Replace(Foundmatches(j), After)
                    .Execute Replace:=wdReplaceAll
                End With
            End If
        Next j
    End With
End Sub

基本上，我使用简单的查找/替换字符串，将找到的每个项目（并将被替换）匹配为正则表达式，Word 中是否存在对它的体面支持）。请注意，任何被替换的文本都采用第一个替换字符的格式，因此如果第一个单词是粗体，那么所有替换的文本都将是粗体。