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

Posted 2021-03-26

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

下面的代码将把数据放入，并且在Y列中它将复制数据时返回yes，但是它当前尝试执行同一文档中的每一行而不是带有粘贴表的新文档。

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

答案

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

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