从所选内容中删除以特定单词开头的段落

Question

我想从所选内容中删除以字符串“Page:”开头的段落

这是我的示例文本：

页数：28

Page: 44 包含很多示例。但是请看这里的详细信息 解释。这可能会超过一、二或三行。这个 完全取决于文本的长度

日期：2018 年 1 月 10 日

一些文字与 Page: 108 一起出现在此处

我这里还有一些文字

还有一些

最终文本

页码：208

到此结束

我目前的代码：

Sub DelPara()

    Dim para As Paragraph

    With Selection.Range.Find
        .ClearFormatting
        .Text = "[^13^11]Page:"
        .Forward = True
        .MatchWildcards = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
        If (Selection.Range.Find = True) Then
            para.Range.Delete
        End If

    End With

End Sub

输出应该是

日期：2018 年 1 月 10 日

一些文字与 Page: 108 一起出现在此处

我这里还有一些文字

还有一些

最终文本

到此结束

Answer 1

下面的代码将在当前选择中搜索搜索词的所有实例，并删除搜索词以及词尾所在的整个段落。

这样做的关键是使用两个Range 对象：一个用于要搜索的原始范围（选择），另一个用于实际搜索。这样，执行实际搜索的范围就可以从上次成功搜索的末尾扩展到原始范围的末尾。

Sub DelPara()
    Dim rngFind As Word.Range, rngSel As Word.Range
    Dim para As Paragraph
    Dim bFound As Boolean

    Set rngSel = Selection.Range
    Set rngFind = rngSel.Duplicate

    With rngFind.Find
        .ClearFormatting
        .text = "[^13^11]Page:"
        .Forward = True
        .MatchWildcards = True
        .wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    bFound = rngFind.Find.Execute
    Do While bFound
        rngFind.End = rngFind.paragraphs.Last.Range.End
        rngFind.Delete
        rngFind.Collapse wdCollapseEnd
        rngFind.End = rngSel.End
        bFound = rngFind.Find.Execute
    Loop

End Sub

Answer 2

您只需要一个通配符查找/替换为：

Find = ^13Page:[!^13]{1,}
Replace = nothing

无需代码。最多，您可能需要在文档的开头插入一个空段落，然后将其删除 - 但前提是第一个段落以“页面：”开头。尽管如此，作为一个宏：

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .InsertBefore vbCr
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Page:[!^13]{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  .Characters.First = vbNullString
End With
Application.ScreenUpdating = True
End Sub

如果您只想处理选定的范围，请将“ActiveDocument”更改为“Selection”。