Vba 如何快速查找和复制Word文档中包含特定文本的段落？（；或者，在Word文档中留下包含特定文本的段落；

我想在Word VBA中编写一个代码，以快速查找和复制Word文档中包含特定文本的段落（或者，在Word文档中保留包含特定文本的段落），但保留一行不完整。这里的代码与我的问题非常相似，但我想剪切/插入段落，而不是删除它们，有人知道如何编写吗？非常感谢

---

我更改了一行，将选定的段落剪切并添加到spike中（我不知道存在该段落！）

然而，出现“是/否”消息框并不能让您真正查看该段落，但希望它对您有用

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

  strFindTexts = InputBox("Enter text strings to be found here, and use commas to separate them: ", "Text strings to be found")
  nSplitItem = UBound(Split(strFindTexts, ","))
  With Selection
    .HomeKey Unit:=wdStory

    ' Find the entered texts one by one.
    For nSplitItem = 0 To nSplitItem
      With Selection.Find
        .ClearFormatting
        .Text = Split(strFindTexts, ",")(nSplitItem)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .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("Click yes to cut/spike graf, no to do nothing", vbYesNo)
        If strButtonValue = vbYes Then
             NormalTemplate.AutoTextEntries.AppendToSpike Range:=Selection.Range

        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    Next
  End With

  MsgBox ("Word has finished finding all entered text strings.")
  Set objDoc = Nothing
End Sub

---

希望有帮助。

是的，有帮助！非常感谢你！