学习Excel技术，关注微信公众号：

excelperfect

我在Excel工作表中存放着数据，如下图1所示。

图1

我想将这些数据逐行自动输入到Word文档的表格中并分别自动保存，Word文档表格如下图2所示，文档名为“datafromexcel.docx”。

图2

解决思路

首先，将需要自动填写的datafromexcel.docx文档作为模板，并对每个要填写的位置放置书签。例如，将光标移至上图2所示表格中姓名后的空格，单击功能区选项卡“插入——书签”，在弹出的“书签”对话框中输入书签名“姓名”，如下图3所示。

图3

同样，在表的其它空格中插入相应的书签，结果如下图4所示。

图4

在Excel工作表中，将相应数据所在的单元格命名，名称与要填写的上图4中表的书签名相同。这就需要我们先命名单元格，待将相应的数据输出到Word表中后，再删除这些名称。然后，移至下一行，再进行单元格命名，并将相应的数据输出到Word表中，再删除这些名称。如此反复，直至工作表每行数据均创建了Word文档。

编写代码

按照上述思路，在存放数据的Excel工作簿中编写代码：

Sub ExportDataToWord()

'变量声明

Dim objWord As Object,docWord As Object

Dim wb As Workbook

Dim xlName As Name

Dim Path As String

Dim lLastRow As Long

Dim i As Long

'下面两个变量可修改为实际工作簿和路径

'设置数据所在工作簿

Set wb = ActiveWorkbook

'要输入数据的Word模板

Path = wb.Path & "\datafromexcel.docx"

'错误处理

On Error GoTo ErrorHandler

'工作簿工作表中最后数据行行号

lLastRow =wb.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

'遍历工作表数据行

'从中取出数据填充Word文档

For i = 2 To lLastRow

'命名名称

With wb.Worksheets("Sheet1")

.Range("A" & i).Name = Range("A1").Value

.Range("B" & i).Name = Range("B1").Value

.Range("C" & i).Name = Range("C1").Value

.Range("D" & i).Name = Range("D1").Value

End With

'创建新的Word实例

Set objWord = CreateObject("Word.Application")

'错误处理

On Error GoTo ErrorHandler

'打开Word文档

Set docWord = objWord.Documents.Add(Path)

'遍历当前工作簿中的名称

For Each xlName In wb.Names

'如果在Word文档中存在与名称相同的书签

If docWord.Bookmarks.Exists(xlName.Name) Then

'将工作表名称的值放入书签所在位置

docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)

End If

Next xlName

With objWord

'激活并显示Word文档

.Visible = True

.ActiveWindow.WindowState = 0

.Activate

'以列A中相应单元格中的数据命名并保存Word文档

.ActiveDocument.SaveAs wb.Path & "\" & Range("A" & i).Value & ".docx"

'退出Word

.Application.Quit

End With

'释放对象

Set objWord = Nothing

'删除名称

Names(Range("A1").Value).Delete

Names(Range("B1").Value).Delete

Names(Range("C1").Value).Delete

Names(Range("D1").Value).Delete

Next i

'释放Word对象并退出过程

ErrorExit:

Set objWord = Nothing

Exit Sub

'错误处理

ErrorHandler:

If Err Then

MsgBox "错误号: " & Err.Number &"; 出问题了."

If Not objWord Is Nothing Then

objWord.QuitFalse

End If

Resume ErrorExit

End If

End Sub

代码中已经给出了详细的注释，有兴趣的朋友可以仔细体会。

运行代码

在运行代码前，要保证代码所在的工作簿与Word文档模板datafromexcel.docx在同一文件夹中。运行ExportDataToWord过程，在文件夹中会生成以列A中的姓名为名称的Word文档，如下图5所示。

图5

打开任一文档，结果都是填写好了的表格，如下图6所示。

图6

代码的图片版如下：