'Issue regarding deleting paragraphs
I refer to a code from :https://www.datanumen.com/blogs/quickly-find-delete-paragraphs-containing-specific-texts-word-document/
However, I can only delete the heading rather than the whole paragraph(heading + content). I've tried several methods but it still not work...please help me with this, thanks!
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
Solution 1:[1]
The problem isn't the code, it is your understanding of what a paragraph is. In your example each line of text is a paragraph.
From your description what you are trying to do is delete blocks of content under a heading containing a keyword, or in Word terminology "a Heading Level". The following code should work for you:
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
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
Solution | Source |
---|---|
Solution 1 | Timothy Rylatt |