从一个Word文档中选择一系列文本,然后复制到另一个Word文档中

从一个Word文档中选择一系列文本,然后复制到另一个Word文档中

问题描述:

我正在尝试使用VBA在一个Word文档中提取句子并将其放入另一个Word文档中. 因此,例如,如果我们需要查找组织的标题,请遵循以下算法:

I'm trying to use VBA to extract sentences in one Word document and put it into another Word document. So for example, if we need to find the title of the organization, we follow the algorithm:

搜索标题"
在标题"之后执行(取走)每个字符,然后(停止)直到地址"

Search for "Title"
Do (Take) each character after "Title" and (stop) until "Address"

以下方法可行,但可能有更有效的方法:

The following works but there may be a more efficient way of doing this:

Sub FindIt()
    Dim blnFound As Boolean
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFound As Range
    Dim strTheText As String

    Application.ScreenUpdating = False
    Selection.HomeKey wdStory
    Selection.Find.Text = "Title"
    blnFound = Selection.Find.Execute
    If blnFound Then
        Selection.MoveRight wdWord
        Set rng1 = Selection.Range
        Selection.Find.Text = "Address"
        blnFound = Selection.Find.Execute
        If blnFound Then
            Set rng2 = Selection.Range
            Set rngFound = ActiveDocument.Range(rng1.Start, rng2.Start)
            strTheText = rngFound.Text
            MsgBox strTheText
        End If
    End If
    'move back to beginning
    Selection.HomeKey wdStory
    Application.ScreenUpdating = True
End Sub

您可以使用激活"(最好使用对象变量)在文档之间进行切换.

You can switch between documents using Activate, preferably using object variables.

Microsoft MVP杰伊·弗里德曼(Jay Freedman)对此进行了友好的修改,以使其在没有Selection对象的情况下也可以工作,从而使其更加整洁.

Microsoft MVP Jay Freedman kindly revised this for me to work without the Selection object, making it much neater.

Sub RevisedFindIt()
' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim strTheText As String

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Title") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="Address") Then
            strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
            MsgBox strTheText
        End If
    End If
End Sub

唯一剩下的要求是将该文本放入另一个文档中.像这样:

The only remaining requirement is to get this text into the other document. Something like:

Documents(2).Range.Text = strTheText