Select 应用查找和替换宏的文本范围

Question

我有一个 Word 宏，可以执行数百个查找和替换操作，但目前它会将这些操作应用于整个文档。我需要它只适用于“摘要”（粗体，匹配大小写）和“参考”（粗体，匹配大小写）之间的文本。

当前代码将更改应用于整个文档，然后在宏的末尾，它使用以下代码追溯拒绝对引用的任何更改：

With Selection.Find
 .ClearFormatting
 .Font.Bold = True
 .MatchCase = True
 .Forward = True
 .Execute FindText:="References"
  
    If .Found = True Then
         
        Selection.Find.Execute
        Selection.Collapse wdCollapseStart

        Dim r1 As Range
        Set r1 = Selection.Range
        
        Selection.Find.Text = "DummyText"
   
        Selection.WholeStory
        Selection.Collapse wdCollapseEnd
  
        Dim r2 As Range
        Set r2 = ActiveDocument.Range(r1.start, Selection.start)
        r2.Select
    
        If Selection.Range.Revisions.Count >= 1 Then _
        Selection.Range.Revisions.RejectAll
        
    End If

End With

这会选择粗体“References”和“DummyText”之间的文本，这只是一些保证找不到的文本，因此它选择到文档的末尾，然后拒绝该选择范围内的任何更改。

我试过调整它并将其放在宏的开头，以便所有查找和替换操作仅适用于摘要和引用之间的选择，如下所示：

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Abstract"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Font.Bold = True
        .MatchCase = True
        .MatchWholeWord = True
    End With
    Selection.Find.Execute
    Selection.Collapse wdCollapseStart

    Dim r1 As Range
    Set r1 = Selection.Range

    Selection.Find.Text = "References"
    Dim r2 As Range
    Set r2 = ActiveDocument.Range(r1.start, Selection.start)
    r2.Select

    ' Move cursor to start, turn on tracked changes
    
    Selection.HomeKey Unit:=wdStory
    ActiveDocument.TrackRevisions = True
    With ActiveWindow.View.RevisionsFilter
        .markup = wdRevisionsMarkupSimple
        .View = wdRevisionsViewFinal
    End With
    
    ' start replacements (these go on for ages, two examples here)
        
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Also "
        .Replacement.Text = "Additionally, "
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
        .Text = "Therefore "
        .Replacement.Text = "Therefore, "
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' and so on...

我读过的其他主题似乎暗示

.Wrap = wdFindStop

在替换字段中会做我想要的，但这不起作用。

有人可以帮忙吗？干杯。

Answer 1

您需要使用多个范围。一旦你确定了搜索范围，那么如果你找到了一些东西，你必须做的第一件事就是确保你找到的东西在这个范围内。下面的示例代码就是这样做的。

Sub FindInRange()
    Dim rng As Word.Range, rStart As Long, rEnd As Long
    Dim iRng As Word.Range
    
    Set rng = ActiveDocument.Content
    With rng.Find
        .ClearFormatting
        .Format = True
        .Forward = True
        .Font.Bold = True
        .MatchCase = True
        .MatchWholeWord = True
        .Text = "Abstract"
        .Wrap = wdFindStop
        .Execute
        If .found = True Then
            rStart = rng.End
            rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            .Text = "References"
            .Execute
            If .found Then
                rEnd = rng.Start
            End If
        End If
    End With
    
    If rStart > 0 And rEnd > 0 Then
        Set iRng = rng
        iRng.Start = rStart
        iRng.End = rEnd
    Else
        Exit Sub
    End If
    
    Set rng = iRng
    With rng.Find
        .ClearFormatting
        .Format = True
        .Forward = True
        .Font.Bold = True
        .MatchCase = True
        .MatchWholeWord = True
        .Text = "Something"
        .Wrap = wdFindStop
        .Execute
        If .found = True And rng.InRange(iRng) Then
            'do something
        End If
    End With
    
End Sub

Answer 2

例如：

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Abstract"
    .Font.Bold = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    Set Rng = .Duplicate
    With .Duplicate
      .End = ActiveDocument.Range.End
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "References"
        .Font.Bold = True
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Execute
      End With
      If .Find.Found = True Then
        Rng.End = .Duplicate.End
        Rng.Revisions.RejectAll
      End If
    End With
  Loop
End With
Application.ScreenUpdating = True
End Sub

如果需要，以上代码可容纳多个 'Abstract' 和 'References' 块。

Select 应用查找和替换宏的文本范围

Select a range of text for a find & replace macro to apply to

vba

ms-word