试图突出显示两个词之间的文字

Question

我有一个我创建的宏几乎就在那里。宏的目的是查找某些单词并突出显示它们，对话框的格式总是相同的，例如per below：

**=====Begin Message=====** 
Message#: 10 
Message Sent: 08/06/2008 04:48:09 
**Susan:** I there How are you 
Peter: I am great thanks 
**Susan:**lekkkkkeeerrr 
Peter:siiiiccckkkk 
**=====End Message=====** 

=====Begin Message===== 
Message#: 10 
Message Sent: 08/06/2008 04:48:09 
Jack: Hey boyyyss…want to get shit faced 
Peter: I am great thanks, keen to do it 
Jack:lekkkkkeeerrr 
Peter:siiiiccckkkk 
=====End Message===== 

现在宏将做什么是突出显示每个文本，说“苏珊”以及“开始”和“结束消息”。那么什么宏将要做的就是打开一个新的Word文档，并粘贴在包含苏珊它和期望的结果应如下消息：

**=====Begin Message=====** 
Message#: 10 
Message Sent: 08/06/2008 04:48:09 
**Susan:** I there How are you 
Peter: I am great thanks 
**Susan:**lekkkkkeeerrr 
Peter:siiiiccckkkk 
**=====End Message=====** 

=====信息起始=== ==

=====结束消息=====

不幸的是，宏不这样做，而是将输出只有一切苏珊说并没有什么什么彼得回答她。如象下面这样：

**=====Begin Message=====** 
Message#: 10 
Message Sent: 08/06/2008 04:48:09 
**Susan:** I there How are you 

**Susan:**lekkkkkeeerrr 

**=====End Message=====** 

    **=====Begin Message=====** 

    **=====End Message=====** 

我突出的原因开始和结束部分是因为宏膏每端开始被强调了，然后采取环绕苏珊hihglight所有段落，但还不够，我想要的一切如果文本突出显示，则在开始消息和结束消息之间。下面是我的代码至今：

Sub CopyParagraphs() 
    Dim DocA As Document 
    Dim DocB As Document 
    Dim para As Paragraph 

    Set DocA = ActiveDocument 
    Set DocB = Documents.Add 

    For Each para In DocA.Paragraphs 
     With para.range.Find 
      .Highlight = True ' could try: If para.range.HighlightColorIndex = wdYellow Then etc etc 
      If .Execute() Then 
       para.range.Copy 
       DocB.Bookmarks("\EndOfDoc").range.Text = "Page " & para.range.Characters.First.Information(wdActiveEndPageNumber) & vbCr 
       DocB.Bookmarks("\EndOfDoc").range.Paste 
       DocB.Bookmarks("\EndOfDoc").range.Text = vbCr & vbCr 
      End If 
     End With 
    Next para 
End Sub 

请提前，所有=====开始留言=====，=====结束消息假装=====和苏珊的话是突出显示的，我只是向你展示我拥有的复制段落代码。

Answer 1

Sub CopyMsg_JarrydWard() 
    Dim DocA As Document 
    Dim DocB As Document 
    Dim para As Paragraph 
    Set DocA = ThisDocument 
    Set DocB = Documents.Add 

    Dim Rg As Range, RgMsg As Range 
    Dim StartWord As String, EndWord As String, NameToHighlight As String 
    Dim FoundName As Boolean 
    Set Rg = DocA.Content 
    Rg.Find.ClearFormatting 
    Rg.Find.Replacement.ClearFormatting 

    StartWord = "=====Begin Message=====" 
    EndWord = "=====End Message=====" 
    NameToHighlight = "Susan" 

    With Rg.Find 
     'Set the parameters for your Find method 
     .Text = StartWord & "*" & EndWord 
     .Forward = True 
     .Wrap = wdFindStop 
     .Format = False 
     .MatchCase = False 
     .MatchWholeWord = False 
     .MatchWildcards = True 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
     'Execute the Find 
     .Execute 
     'Loop through the results 
     While .Found 
      'Boolean to copy only message containing NameToHighlight 
      FoundName = False 
      'Keep Rg (result range for whole message) intact for later copy 
      Set RgMsg = Rg.Duplicate 

      'Highlight 
      'Start and End 
      DocA.Range(Start:=Rg.Start, End:=Rg.Start + Len(StartWord)).Bold = True 
      DocA.Range(Start:=Rg.End - Len(EndWord), End:=Rg.End).Bold = True 
      'NameToHighlight : here : Susan 
      With RgMsg.Find 
       'Set the parameters for your Find method 
       .Text = NameToHighlight 
       .Forward = True 
       .Wrap = wdFindStop 
       .Format = False 
       .MatchCase = False 
       .MatchWholeWord = False 
       .MatchWildcards = False 
       .MatchSoundsLike = False 
       .MatchAllWordForms = False 
       'Execute the Find 
       .Execute 
       'Loop through the results 
       While .Found 
        RgMsg.Bold = True 
        FoundName = True 
        'Go to the next result for NameToHighlight 
        .Execute 
       Wend 
      End With 'RgMsg.Find 

      'Copy the whole message if NameToHighlight was found 
      If FoundName Then 
       Rg.Copy 
       DocB.Bookmarks("\EndOfDoc").Range.Text = "Page " & _ 
         Rg.Characters.First.Information(wdActiveEndPageNumber) & vbCr 
       DocB.Bookmarks("\EndOfDoc").Range.Paste 
       DocB.Bookmarks("\EndOfDoc").Range.Text = vbCr & vbCr 
      End If 
      'Go to the next result for the message 
      .Execute 
     Wend 
    End With 'Rg.Find 
End Sub