循环:使用书签将基于excel列表的段落从一个文档复制到另一个文档 [英] Loop: Copy paragraph based on excel list from one document to another using bookmark

问题描述

有关更多详细信息，请参阅下面的屏幕截图.

Please refer below screenshot for more details.

Excel工作表

原始文档

在目标文档中我的代码输出下面

Below my code output in Destination Document

目标文档中的Macropod输出

Macropod output in Destination Document

excel文件Sheets("List1")，包含两列带有文本/字符串的列.列A具有段落或表格的起始词，列B具有结束段落或表格的词.

The excel file Sheets("List1"), containing two columns with text/string. Column A having starting word of paragraph or table and Column B having ending word of paragraph or table.

基于A列和B列文本，宏在源文档中找到开始和结束的单词.如果找到了，则复制具有格式的源文件中的所有文本或表格，包括开始和结束的单词，并将其粘贴到具有源格式的目标文档中的书签(Text1，Text2等)上.

Based on column A and B text, the macro find the starting and ending word in source document. If found then, copy all text or table including starting and ending word from source document with formatting and past it at bookmarks (Text1, Text2 and so on) in destination document with source formatting.

我要复制的段落包含文本和表格(介于两个文本之间或位于末尾)

The paragraph I am trying to copy contains text and tables (either in between two text or at end)

如何使用书签循环来循环A和B列的文本/字符串.

How to loop column A and B text/string with loop of bookmark.

在宏下面，我尝试基于源文档中的A列和B列查找文本，使用格式进行复制并将其粘贴到目标文档中的书签中.

Below macro what I have try is find text based on column A and B in source document, copy with formatting and paste it at bookmark in destination document.

但是它选择每个循环中最后一个条目的范围(文本或表格).我尝试编辑以下代码，但未成功.我没有很好的编码知识.

But it selecting range (text or table) of last entry in each loop. I have try to edit below code but not succeeded. I do not have good knowledge of coding.

从Macropod和我的评论中获得的答案非常好.

Kindly look wonderful answer received from Macropod and my comments.

Sub CopyPasteParagraphsNew()
Dim wdApp As New Word.Application
Dim DocSrc As Word.Document, DocTgt As Word.Document, wdRng As Word.Range
Dim WS As Worksheet, r As Long
Dim i As Long
Dim j As Long

Dim M As Long
Dim N As Long


Set WS = Sheets("List1")
  Set MsWord = CreateObject("Word.Application")
  On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wrdApp Is Nothing Then
Set wrdApp = CreateObject("Word.Application")
bWeStartedWord = True
End If

With DocSrc

With MsWord
.Visible = True
.Documents.Open (ActiveWorkbook.Path & "\Source Document.doc")
.Activate

MsWord.Selection.HomeKey Unit:=wdStory
With MsWord.Selection.Find

M = Cells(Rows.Count, "A").End(xlUp).Row 'selecting last string of column A and pasting at each bookmark
For i = 1 To M
.ClearFormatting
.Wrap = wdFindStop
.MatchCase = True
.Text = Cells(i, "A").Value
.Execute
MsWord.Selection.Collapse

Next i

N = Cells(Rows.Count, "B").End(xlUp).Row 'selecting last string of column B and pasting at each bookmark
For j = 1 To N
lngStart = MsWord.Selection.End
.Text = Cells(j, "B").Value
.Execute

Next j
lngEnd = MsWord.Selection.End
MsWord.ActiveDocument.Range(lngStart, lngEnd).Copy

Set DocTgt = Documents.Open(ActiveWorkbook.Path & "\Destination Document.doc")
With DocTgt
 For t = 1 To DocTgt.Bookmarks.Count
If DocTgt.Bookmarks.Exists("Text" & t) Then

MsWord.Selection.GoTo What:=wdGoToBookmark, Name:=("Text" & t)
MsWord.Selection.PasteAndFormat wdFormatOriginalFormatting

End If
Next
End With
End With
End With
End With
End Sub

推荐答案

您的描述不清楚.也许:

Your description is unclear. Perhaps:

Sub CopyPasteParagraphs()
Dim wdApp As New Word.Application
Dim DocSrc As Word.Document, DocTgt As Word.Document, wdRng As Word.Range
Dim WS As Worksheet, r As Long
Set WS = Sheets("List1")
With wdApp
  .Visible = True
  Set DocSrc = .Documents.Open(ActiveWorkbook.Path & "\Source Document.doc") 'SourceDocument
  Set DocTgt = Documents.Open(ActiveDocument.Path & "\Destination Document.doc")
  With DocSrc
    For r = 1 To WS.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    With .Range
      With .Find
        .Text = WS.Range("A" & r) & "*" & WS.Range("B" & r)
        .MatchWildcards = True
        .Execute
      End With
      If .Find.Found = True Then Set wdRng = .Duplicate
        With DocTgt
          If .Bookmarks.Exists("Text" & r) Then
            .Bookmarks("Text" & r).Range.FormattedText = wdRng.FormattedText
          End If
        End If
      End If
    End With
    .Close False
  End With
End With
End Sub

代替:

      If .Bookmarks.Exists("Text" & r) Then
        .Bookmarks("Text" & r).Range.FormattedText = wdRng.FormattedText
      End If

您可以使用:

      If .Bookmarks.Exists("Text" & r) Then
        wdRng.Copy
        .Bookmarks("Text" & r).Range.PasteAndFormat wdFormatOriginalFormatting
      End If

这篇关于循环:使用书签将基于excel列表的段落从一个文档复制到另一个文档的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！