Question

我创建的宏几乎就在那里。宏用于查找某些单词并突出显示它们，对话框的格式始终相同，下面是一个示例：

**=====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=====

现在宏将做的是突出显示每个文字＆＃34; susan＆＃34;以及＆＃34;开始＆＃34;和＆＃34;结束消息＆＃34;。然后宏将做的是打开一个新的word文档并粘贴其中包含susan的消息，所需的结果应如下所示：

**=====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的所有段落，但它还不够，我想要在Begin消息和结束消息之间的所有内容，如果文字突出显示。以下是我到目前为止的代码：

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

试图突出两个单词之间的文本

1 个答案: