Question

我有一个文档模板，需要用我的工作簿中的数据填充-我设法将其添加到带有书签的Word文档的正确部分中，但希望这样做每行新文档。

下面的代码将把数据放进去，复制数据后，Y列将放一个是，但是当前它尝试在同一文档中而不是在粘贴了表格的新文档中进行每一行。 / p>

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

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

1 个答案: