Question

我有以下代码填写word文档模板。我想要做的是在填写工作表时为每一行创建一个新文档。

我尝试通过添加

来更改书签Range

Range("e5").Select
Do Until ActiveCell.Value = ""
loop

但整件事情都崩溃了......

Sub CreateWR()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim objword As Object
    Set objword = CreateObject("Word.Application")
    objword.Visible = True

    objword.Documents.Open ("C:\User\Documents\FileControl\template.doc")
    With objword.ActiveDocument
    .Bookmarks("PropertyName").Range.Text = ws.Range("a2").Value
    .Bookmarks("ProjectNumber").Range.Text = ws.Range("b2").Value
    .Bookmarks("BudgetNumber").Range.Text = ws.Range("c2").Value
    .Bookmarks("ProjecName").Range.Text = ws.Range("d2").Value
    .Bookmarks("Vendor_1").Range.Text = ws.Range("e2").Value
    .Bookmarks("Price_1").Range.Text = ws.Range("f2").Value
    .Bookmarks("Vendor_2").Range.Text = ws.Range("g2").Value
    .Bookmarks("Price_2").Range.Text = ws.Range("h2").Value
    .Bookmarks("Vendor_3").Range.Text = ws.Range("i2").Value
    .Bookmarks("Price_3").Range.Text = ws.Range("j2").Value
    .Bookmarks("Vendor_1_2").Range.Text = ws.Range("e2").Value
    .Bookmarks("RequestedBy").Range.Text = ws.Range("m2").Value

    End With
End Sub

Answer 1

这不是你的最终解决方案，因为它不是100％清楚行计数器的上限应该是什么，而是为了给你一个开始，见下文。

For循环行数。目前，我已将5放在那里，供您测试基础是否有效。

文档在此循环内生成。请注意，Open已更改为Add，以便从模板创建新文档。此外，对象变量objDoc在顶部声明，新文档分配给它。这也用于处理书签，而不是ActiveDocument。在循环结束时objDoc设置为Nothing以准备下一次迭代。

rowCounter已替换原始代码中的静态行值，因此每个循环都将移动到下一行。

Sub CreateWR()        
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim rowCounter as Long
    Dim objword As Object
    Dim objDoc as Object
    Set objword = CreateObject("Word.Application")
    objword.Visible = True

    For rowCounter = 2 to 5
      Set objDoc = objword.Documents.Add ("C:\User\Documents\FileControl\template.doc")
      With objDoc
        .Bookmarks("PropertyName").Range.Text = ws.Range("a" & CStr(rowCounter)).Value
        .Bookmarks("ProjectNumber").Range.Text = ws.Range("b" & CStr(rowCounter)).Value
        .Bookmarks("BudgetNumber").Range.Text = ws.Range("c" & CStr(rowCounter)).Value
        .Bookmarks("ProjecName").Range.Text = ws.Range("d" & CStr(rowCounter)).Value
        .Bookmarks("Vendor_1").Range.Text = ws.Range("e" & CStr(rowCounter)).Value
        .Bookmarks("Price_1").Range.Text = ws.Range("f" & CStr(rowCounter)).Value
        .Bookmarks("Vendor_2").Range.Text = ws.Range("g" & CStr(rowCounter)).Value
        .Bookmarks("Price_2").Range.Text = ws.Range("h" & CStr(rowCounter)).Value
        .Bookmarks("Vendor_3").Range.Text = ws.Range("i" & CStr(rowCounter)).Value
        .Bookmarks("Price_3").Range.Text = ws.Range("j" & CStr(rowCounter)).Value
        .Bookmarks("Vendor_1_2").Range.Text = ws.Range("e" & CStr(rowCounter)).Value
        .Bookmarks("RequestedBy").Range.Text = ws.Range("m" & CStr(rowCounter)).Value
      End With
      Set objDoc = Nothing
    Next
End Sub

每个新行应创建一个具有相同格式的独立word文档

1 个答案: