我想在 Word 中使用 VBA 執行以下步驟：
- 設定關鍵字文字
- 在所有標題中查找關鍵字（在 Heading1、Heading2 和 Heading3 中）
- 如果關鍵字出現在標題（標題）中，則洗掉整個段落
前任。關鍵字=“狗”
（前）
1.1 我愛狗
1.1.1 dsjnfkfjsnk
1.1.2 eoiwfmojiejm
2.1 nsodjfnvocjn
2.1.1 nsjkdefncwje狗
2.1.2 koiqpoemkoxm
（后）
2.1 nsodjfnvocjn
2.1.1 koiqpoemkoxm
到目前為止，我參考的代碼來自：https ://www.datanumen.com/blogs/quickly-find-delete-paragraphs- contains-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
uj5u.com熱心網友回復：
問題不在于代碼，而在于您對段落的理解。在您的示例中，每一行文本都是一個段落。
從您的描述中，您嘗試做的是洗掉包含關鍵字的標題下的內容塊，或者在 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
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/472659.html