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

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:UserDocumentsFileControltemplate.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:UserDocumentsFileControltemplate.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