在两个单词内的文本上运行单词 VBA 宏

Question

我有一个宏，可以将轨道更改转换为下划线或删除线，它在整个 Word 文档上执行此操作。但是，我希望它仅在第一个标签和第二个标签之间找到的文档部分内的轨道更改上运行（假设在“开始”和“结束”这两个词之间）。我不希望这个宏在这两个标签之间以外的任何地方进行更改。换句话说，如果我运行此宏，则仅应根据宏修改这两个标记内的跟踪更改，文档的其余部分应保持其跟踪更改不变。

如果您可以根据上述要求帮助我修改此宏，请告诉我。

这是我所拥有的，但它在整个文档上运行。

Sub FormatRevisions()
Dim rev As Revision, txt As String, r As Long, ran As Range

'First switch off TrackChanges, else each of your reformattings will become a revision again
ActiveDocument.TrackRevisions = False

'***Now cycle through revisions, identify type of change
For Each rev In ActiveDocument.Revisions
    Select Case rev.Type
        Case wdRevisionDelete
            'secure "deleted" text as well as its position
            txt = rev.Range.Text
            r = rev.Range.Start
            'accept the revision to make the markup disappear
            rev.Accept
            'now type the text formatted as strikethrough at the position of the old text
            Set ran = ActiveDocument.Range(r, r)
            With ran
                .Text = txt
                .Font.StrikeThrough = 1
            End With
        Case wdRevisionInsert
            Set ran = rev.Range
            'accept the revision to make the markup disappear
            rev.Accept
            'now type the text formatted as underlined at the position of the old text
            ran.Font.Underline = 1
    End Select
Next rev
End Sub

Answer 1

试试：

Sub FormatRevisions()
Application.ScreenUpdating = False
Dim Rvn As Revision, Rng As Range
'First switch off TrackChanges, else each of your reformattings will become a revision again
ActiveDocument.TrackRevisions = False
With ActiveDocument.Range
  'Find the defined range
  With .Find
    .Text = "Beginning*Ending"
    .MatchWildcards = True
    .Execute
  End With
  If .Find.Found = True Then

    '***Now cycle through revisions, identify type of change
    For Each Rvn In .Revisions
      With Rvn
        Select Case .Type
          Case wdRevisionDelete
            Set Rng = .Range
            'Reject the revision to make the markup disappear
            .Reject
            'now format the text as strikethrough
            Rng.Font.StrikeThrough = True
          Case wdRevisionInsert
            Set Rng = .Range
            'Accept the revision to make the markup disappear
            .Accept
            'now format the text as underlined
            Rng.Font.Underline = wdUnderlineSingle
        End Select
      End With
    Next
  End If
End With
Application.ScreenUpdating = True
End Sub

上述方法还有一个优点是保留了删除和添加文本的格式。