Question

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

https://www.datanumen.com/blogs/quickly-find-delete-paragraphs-containing-specific-texts-word-document/

Answer 1

我更改了一条线以剪切并将选定的段落添加到峰值（我不知道它存在！）

是/否消息框的存在并不能真正让您查看该段落，但希望它对您有用。

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

希望有帮助。

如何快速查找和复制Word文档中包含特定文本的段落？（或，将包含特定文本的段落保留在Word文档中？）

1 个答案: