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

时间:2018-09-25 03:14:25

标签: vba ms-word

我有一个宏,可将轨迹更改转换为下划线或删除线,并在整个Word文档中执行。但是,我希望它仅在第一个标签和第二个标签之间的文档部分中(仅在单词“ Beginning”和“ Ending”之间出现)中按轨道运行。我不希望此宏在这两个标记之间进行任何更改。换句话说,如果我运行此宏,则仅应基于该宏修改这两个标记内的跟踪更改,而文档的其余部分应保持其跟踪更改完整。

请告知我是否可以根据上述要求帮助我修改此宏。

这就是我所拥有的,但是它可以在整个文档中运行。

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

1 个答案:

答案 0 :(得分:0)

尝试:

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

上述方法还具有保留已删除和已添加文本格式的优点。