写入word_[网友投稿] Excel数据批量写入Word

前言：这是 VBA说 微信公众号借助我的这个平台给大家分享的一篇关于Excel与Word交互的文章，希望对大家有帮助。在这里，欢迎大家投稿，与更多的人分享有用的知识。

之前有两篇文章讲过Excel和Word数据交互的基础知识Excel和Word数据交互读取(一)和Excel和Word数据交互读取(二)，这里说个实际遇到的综合案例，基本上将之前的知识点结合起来了。

一、实际案例引入

这次遇到的案例需求：将Excel数据批量写入Word。需要写入的内容如下图所示，红色框里的内容是需要写入word的。

我这里有很多个excel文件，每一个都需要打开把数据写入word。

写入之后的效果如下：

二、思路及代码 

思路：循环打开Excel，先写订单号、厂款号、客款号。第二步需要通过find函数确定长款号表格的具体大小(为了将数据循环写入Word)。最后保存并关闭word。

具体代码如下：

Sub 提取数据()

    Application.ScreenUpdating = False

    Set doc = CreateObject("word.application")

    doc.Visible = True

    Set wd = doc.Documents.Add

    pth = Application.GetOpenFilename("文件(*.*),*.*", , "请选择文件", , True)

    For i = 1 To UBound(pth) '循环打开选择的工作簿

        Set wb = Workbooks.Open(pth(i)) '把打开的工作簿赋值给对象变量wb

        strr = "订单号码" & wb.Worksheets(1).[b3] & vbTab & "客款号 " & wb.Worksheets(1).[b5] & vbTab & "厂款号" & wb.Worksheets(1).[b6] '将需要写入的数据连接起来赋值给变量strr

         doc.ActiveDocument.Content.InsertAfter Chr$(13) & strr '将订单编号、客款号、厂款号写入word

        With wb.Worksheets(1)

            col1 = .Columns(1).Find("厂款号", , xlValues, xlWhole, xlByColumns, xlNext, True, True).Row '定位厂款号跟合计字符，为了确定需要插入word文档中表格的大小

            col2 = .Columns(1).Find("合计", , xlValues, xlWhole, xlByColumns, xlNext, True, True).Row

            Set myrange = doc.ActiveDocument.Content

            myrange.Collapse Direction:=wdCollapseEnd '折叠已经写入的内容

            doc.Documents(1).Tables.Add myrange, col2 - col1, 11 '在word中插入新的表

            doc.Documents(1).Tables(i).Style = "网格型" '表格类型是网格型

            For r = col1 To col2 - 1

                arr = .Range("a" & r).EntireRow.Range("a1:k1") '循环将excel表中的数据写入word表格中

                For Each ar In arr

                    n = n + 1 '将所在行的单元格值循环写入word表的单元格中

                    doc.Documents(1).Tables(i).Range.Cells(n).Range = ar

                Next

            Next

            n = 0

        End With

        wb.Close False '数据写入完毕，关闭打开的工作簿'接着打开后面一个工作簿

    Next

    doc.Documents(1).SaveAs ThisWorkbook.Path & "\数据.docx" '将所有的工作簿循环打开，写入数据完毕，保存打开的word文档到代码工作簿路径下

    doc.Quit '退出程序

    Application.ScreenUpdating = True

End Sub

三、知识点 

新建表格

代码中涉及到新建表格并写入数据的地方，这里给一个简单的例子作为参考。(这个代码直接在Word VBA中运行，如果需要在Excel中操作Word插入表格，需要新建Word程序对象，这属于前面的基础知识)

Sub 新建表格写入数据()    ActiveDocument.Tables(1).Delete    Set tb = ActiveDocument.Tables.Add(Selection.Range, 1, 3)    With tb        .Style = "网格型"        .Cell(1, 1).Range = "编号"        .Cell(1, 2).Range = "文件名"        .Cell(1, 3).Range = "扩展名"        

        .Rows.Last.Select        Selection.InsertRowsBelow 1        With .Rows.Last            .Cells(1).Range = 1            .Cells(2).Range = 2            .Cells(3).Range = 3        End With    End With

End Sub

代码运行效果如下：

Excel VBA Find方法和GetOpenFileName方法

这里有我之前总结的这两个方法的具体使用，我觉得已经很详细了，供大家阅读参考。

代码打开workbook的两种方法

不得不说的高效Boy：Find方法

在完美Excel公众号底部发消息：

Excel数据批量写入Word

下载示例文档。