关于删除段落的问题

Question

我引用的代码来自：https://www.datanumen.com/blogs/quickly-find-delete-paragraphs-containing-specific-texts-word-document/

但是，我只能删除标题而不是整个段落（标题+内容）。我已经尝试了几种方法，但仍然没有用...请帮助我，谢谢！

Sub DeleteParagraphsContainingSpecificTexts()
  Dim strFindTexts As String
  Dim strButtonValue As String
  Dim nSplitItem As Long
  Dim objDoc As Document

  strFindTexts = InputBox("Enter texts to be found here, and use commas to separate them: ", "Texts to be found")
  nSplitItem = UBound(Split(strFindTexts, ","))
  With Selection
    .HomeKey Unit:=wdStory
 
    ' Find the entered texts one by one.
    For nSplitItem = 0 To nSplitItem


      ' Find text in Heading1
    
      With Selection.Find
        .ClearFormatting
        .Text = Split(strFindTexts, ",")(nSplitItem)
        .Style = wdStyleHeading1
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWholeWord = False 
        .MatchCase = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchAllWordForms = False
        .Execute
      End With

      Do While .Find.Found = True
        ' Expand the selection to the entire paragraph.
        Selection.Expand Unit:=wdParagraph
        strButtonValue = MsgBox("Are you sure to delete the paragraph?", vbYesNo)
        If strButtonValue = vbYes Then
          Selection.Delete
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop


    ' Find text in Heading2
    
      With Selection.Find
        .ClearFormatting
        .Text = Split(strFindTexts, ",")(nSplitItem)
        .Style = wdStyleHeading2
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWholeWord = False
        .MatchCase = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchAllWordForms = False
        .Execute
      End With

      Do While .Find.Found = True
        ' Expand the selection to the entire paragraph.
        Selection.Expand Unit:=wdParagraph
        strButtonValue = MsgBox("Are you sure to delete the paragraph?", vbYesNo)
        If strButtonValue = vbYes Then
          Selection.Delete
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
      
      ' Find text in Heading3
      
      With Selection.Find
        .ClearFormatting
        .Text = Split(strFindTexts, ",")(nSplitItem)
        .Style = wdStyleHeading3
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWholeWord = False
        .MatchCase = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchAllWordForms = False
        .Execute
      End With

      Do While .Find.Found = True
        ' Expand the selection to the entire paragraph.
        Selection.Expand Unit:=wdParagraph
        strButtonValue = MsgBox("Are you sure to delete the paragraph?", vbYesNo)
        If strButtonValue = vbYes Then
          Selection.Delete
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
      
      
    Next
  End With

  MsgBox ("Word has finished finding all entered texts.")
  Set objDoc = Nothing

End Sub

Answer 1

问题不在于代码，而在于您对段落的理解。在您的示例中，每行文本都是一个段落。

根据您的描述，您尝试做的是删除包含关键字的标题下的内容块，或者在 Word 术语“标题级别”中。以下代码应该适合您：

Sub DeleteParagraphsContainingSpecificTexts()
  Dim strFindTexts As String
  Dim strButtonValue As String
  Dim nSplitItem As Long
  Dim objDoc As Document

  strFindTexts = InputBox("Enter texts to be found here, and use commas to separate them: ", "Texts to be found")
  nSplitItem = UBound(Split(strFindTexts, ","))
 
    ' Find the entered texts one by one.
    For nSplitItem = 0 To nSplitItem
        DeleteHeadingBlock Split(strFindTexts, ",")(nSplitItem), wdStyleHeading1
        DeleteHeadingBlock Split(strFindTexts, ",")(nSplitItem), wdStyleHeading2
        DeleteHeadingBlock Split(strFindTexts, ",")(nSplitItem), wdStyleHeading3
    Next
End Sub

Public Sub DeleteHeadingBlock(ByVal headingText As String, headingStyle As WdBuiltinStyle)
    Dim hdgBlock As Range
    With ActiveDocument.Content
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = headingText
            .Style = headingStyle
            .Replacement.Text = ""
            .Forward = True
            .Format = True
            .Wrap = wdFindStop
        End With
        Do While .Find.Execute
            Set hdgBlock = .GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
            hdgBlock.Delete
        Loop
    End With
End Sub

关于删除段落的问题

Issue regarding deleting paragraphs

vba