Excel应用实践20:使用Excel中的数据自动填写Word表格

2019-08-30 21:14:59 浏览数 (1)

我在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

代码的图片版如下:

0 人点赞