Создание нового документа Word из каждой строки данных Excel

Question

У меня есть шаблон документа, который должен быть заполнен данными из моей рабочей книги - мне удалось заставить его поместить правильные данные в правильную часть документа 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

Answer 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