我在Excel工作表中存放着数据,如下图1所示。
图1
我想将这些数据逐行自动输入到Word文档的表格中并分别自动保存,Word文档表格如下图2所示,文档名为“datafromexcel.docx”。
图2
解决思路
首先,将需要自动填写的datafromexcel.docx文档作为模板,并对每个要填写的位置放置书签。例如,将光标移至上图2所示表格中姓名后的空格,单击功能区选项卡“插入——书签”,在弹出的“书签”对话框中输入书签名“姓名”,如下图3所示。
图3
同样,在表的其它空格中插入相应的书签,结果如下图4所示。
图4
在Excel工作表中,将相应数据所在的单元格命名,名称与要填写的上图4中表的书签名相同。这就需要我们先命名单元格,待将相应的数据输出到Word表中后,再删除这些名称。然后,移至下一行,再进行单元格命名,并将相应的数据输出到Word表中,再删除这些名称。如此反复,直至工作表每行数据均创建了Word文档。
编写代码
按照上述思路,在存放数据的Excel工作簿中编写代码:
代码语言:javascript复制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
代码的图片版如下: