从每一行 Excel 数据创建一个新的 Word 文档答案

【问题标题】：Creating a new Word document from each row of Excel data从每一行 Excel 数据创建一个新的 Word 文档
【发布时间】：2020-04-10 02:37:36
【问题描述】：

我有一个文档模板，需要用我的工作簿中的数据填写 - 我已经设法让它将正确的数据放在带有书签的 Word 文档的正确部分，但希望它做一个每行都有新的文档。

下面的代码会将数据放入其中，并且在 Y 列中将在复制数据后输入“是”，但是它目前尝试在同一文档中执行每一行，而不是在粘贴表格的新文档中执行。

Public Sub openExistingWordFile()

   Dim objWord
   Dim objDoc
   Dim objRange

   Set objWord = CreateObject("Word.Application")
   Set objDoc = objWord.Documents.Open(".... Draft Invoice Template.doc")

   objWord.Visible = True

   objWord.Selection.WholeStory
   objWord.Selection.Copy


 R = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 6 To R
        With Cells(i, 2)
            If .Value <> "" And Cells(i, 25) = "" Then
                Cells(i, 25) = "Yes"

    Set objRange = objDoc.Bookmarks("OurRef").Range
    objRange.InsertAfter Cells(i, 4)

    Set objRange = objDoc.Bookmarks("WorkRef").Range
    objRange.InsertAfter Cells(i, 5)

    Set objRange = objDoc.Bookmarks("Location").Range
    objRange.InsertAfter Cells(i, 7)

    Set objRange = objDoc.Bookmarks("WorksType").Range
    objRange.InsertAfter Cells(i, 11)

    Set objRange = objDoc.Bookmarks("ReinCat").Range
    objRange.InsertAfter Cells(i, 12)

    Set objRange = objDoc.Bookmarks("TS").Range
    objRange.InsertAfter Cells(i, 13)

    Set objRange = objDoc.Bookmarks("Charge").Range
    objRange.InsertAfter Cells(i, 18)

    Set objRange = objDoc.Bookmarks("From").Range
    objRange.InsertAfter Cells(i, 15)

    Set objRange = objDoc.Bookmarks("To").Range
    objRange.InsertAfter Cells(i, 16)

    Set objRange = objDoc.Bookmarks("Days").Range
    objRange.InsertAfter Cells(i, 17)

    Set objRange = objDoc.Bookmarks("Total").Range
    objRange.InsertAfter Cells(i, 24)

    Set objRange = objDoc.Bookmarks("Date").Range
    objRange.InsertDateTime DateTimeFormat:="d/M/yyyy"


    objWord.Documents.Add DocumentType:=wdNewBlankDocument
    objWord.Activate
    objWord.Selection.PasteAndFormat (wdUseDestinationStylesRecovery)

        End If
        End With

    Next i


    End Sub

【问题讨论】：

这将有助于在每次迭代后保存您的文档。现在您只需继续迭代 Next i 并在每个书签之后覆盖值。
因为它们需要保存在不同的位置我不想在每次迭代后保存它们，我设法让它复制原始模板并粘贴到一个新文档中，但是然后它仍然将范围插入到原始文档中（上面编辑的代码）
然后创建一个新的objWord.Documents.Open(".....Draft Invoice Template.doc") 开始每次迭代？
我希望它把模板复制到一个新的单词文档中，粘贴它，然后如果可能的话，在上面插入下一行值？
Copying Excel data into specific sections of a Word document的可能重复

标签： excel vba ms-word

【解决方案1】：

我最终设法对此进行了排序，如果有人感兴趣，请在下面进行代码。

Public Sub openExistingWordFile()

   Dim objWord
   Dim objDoc
   Dim objRange

   Set objWord = CreateObject("Word.Application")
   Set objDoc = objWord.Documents.Add(Template:="...S74 Draft Invoice Template.doc", NewTemplate:=False, DocumentType:=0)

   objWord.Visible = True


r = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 6 To r
        With Cells(i, 2)
            If .Value <> "" And Cells(i, 25) = "" Then
                Cells(i, 25) = "Yes"

    Set objRange = objDoc.Bookmarks("OurRef").Range
    objRange.InsertAfter Cells(i, 4)

    Set objRange = objDoc.Bookmarks("WorkRef").Range
    objRange.InsertAfter Cells(i, 5)

    Set objRange = objDoc.Bookmarks("Location").Range
    objRange.InsertAfter Cells(i, 7)

    Set objRange = objDoc.Bookmarks("WorksType").Range
    objRange.InsertAfter Cells(i, 11)

    Set objRange = objDoc.Bookmarks("ReinCat").Range
    objRange.InsertAfter Cells(i, 12)

    Set objRange = objDoc.Bookmarks("TS").Range
    objRange.InsertAfter Cells(i, 13)

    Set objRange = objDoc.Bookmarks("Charge").Range
    objRange.InsertAfter Cells(i, 18)

    Set objRange = objDoc.Bookmarks("From").Range
    objRange.InsertAfter Cells(i, 15)

    Set objRange = objDoc.Bookmarks("To").Range
    objRange.InsertAfter Cells(i, 16)

    Set objRange = objDoc.Bookmarks("Days").Range
    objRange.InsertAfter Cells(i, 17)

    Set objRange = objDoc.Bookmarks("Total").Range
    objRange.InsertAfter Cells(i, 24)

    Set objRange = objDoc.Bookmarks("Date").Range
    objRange.InsertDateTime DateTimeFormat:="d/M/yyyy"

    Set objDoc = objWord.Documents.Add(Template:="...S74 Draft Invoice Template.doc", NewTemplate:=False, DocumentType:=0)

    objWord.Activate


        End If
        End With

    Next i

    objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

    End Sub

【讨论】：