根据Excel数据更新Word表

Question

我有一个在MS Word中创建的报告模板。现在，我在Excel电子表格中有一些数据需要与报表模板合并。我探索了MS Word中的Mail Merge功能，可以在其中创建多个报告。但是，正如我所见，如果每行的数据都是统一的，那么该函数只是静态的，并且只能工作，而我不是。 Excel中的样本数据是

数据以以下格式显示在文字中，

Sub CopyRowToRC()
Sheet2.Range("A:B").Clear
i = 1
j = 2
Application.ScreenUpdating = False
With Sheet1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To LastRow

With Sheet2
LastRows = .Cells(.Rows.Count, "A").End(xlUp).Row
If i > 1 Then
LastRows = LastRows + 2
End If
End With

If j <= LastRow Then
Sheet1.Rows(1).SpecialCells(xlCellTypeConstants).Copy
Sheet2.Range("A" & LastRows).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
Sheet1.Rows(j).SpecialCells(xlCellTypeConstants).Copy
Sheet2.Range("B" & LastRows).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
j = j + 1
End If
Next
Sheet2.Activate
Application.ScreenUpdating = False
WordUp
End Sub


Sub WordUp()
On Error Resume Next
Dim WdObj As Object, fname As String
fname = "File Name"
Set WdObj = CreateObject("Word.Application")
WdObj.Visible = True

With Sheet2
LastRows = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Sheet2.Range("A1:B" & LastRows).Copy

WdObj.documents.Add
WdObj.Selection.PasteExcelTable False, False, False
With WdObj
    .ActiveDocument.Close
    .Quit
End With
Set WdObj = Nothing
Sheet2.Range("A:B").Clear
Sheet1.Activate
Application.ScreenUpdating = True
End Sub

上面的代码通过将列转换为行，可以帮助我为Word中附加的第二个Excel格式的每一行创建一个表。但是也有数据要粘贴到表外。

Answer 1

由于这似乎是一种标准的文档格式-您将要重复使用某些格式-第一步是使用基本的“结构”创建Word文档。输入并格式化所有不会改变的静态文本。使用功能区中的“插入/链接/书签”命令为来自Excel（或任何其他来源）的动态数据设置“目标”。

将其另存为模板（dotx文件格式）。更改您的WdObj.documents.Add代码行以选择此文件路径。将基于该模板创建一个新文档，其中将包含静态文本以及书签。确保将其设置为Word.Document对象：

Dim wdDoc as Word.Document 'or As Object if you don't have a reference to the Word library
Set wdDoc = WdObj.Documents.Add("filepath")

定位您在代码中定义的书签*：

Dim rngTarget as Word.Range
Set rngTarget = wdDoc.Bookmarks("NameOfBookmark").Range
rngTarget.PasteExcelTable False, False, False

Set rngTarget = wdDoc.Bookmarks("DifferentBookmark").Range
rngTarget.Text = Sheet1.Range("A2").Value2 'for example, to get the name

完成后，请不要忘记在保存文件之前保存 ...

wdDoc.SaveAs "filepath"
wdDoc.Close
wdObj.Quit
Set wdDoc = Nothing
Set wdObj = Nothing

此外，请正确使用错误处理。就目前而言，您不会看到任何错误，但是您需要查看它们。否则，您将不知道代码是否或为什么失败。从代码中删除On Error Resume Next-仅在您使用GetObject来拾取运行的Word应用程序时才有意义。在这种情况下，紧接着是On Error GoTo 0，它会重新打开错误。

*注意：您可以直接分配给书签，但是如果需要其他范围（例如格式），最好分两步进行。要直接分配：

wdDoc.Bookmarks("NameOfBookmark").Range.Text = "abc"