Excel批量生成word

一、使用“邮件合并分布向导”

1. 准备好需要替换数据的Excel数据源，如下：

2、打开Word模板文件，切换到“邮件”功能区→开始邮件合并→邮件合并分布向导，如下：

3、任务窗格默认，选择“下一步：正在启动文档”，如下：

4、任务窗格默认，选择“下一步：选取收件人”，如下：

5、任务窗格中选择“浏览”，找到Excel文件，设置好Excel文件后，点击下一步，如下：

6、在任务窗格中，点击“其他项目”可以在Word中插入Excel的数据，如下：

7、下一步直到完成，然后就可以在“邮件”功能区进行相关操作，如下：

8、然后可用以下vba代码完成按当前Word生成文档，如下：

Sub myMailMerge()

'主文档的类型为信函

'合并全部数据记录

'假设主文档已链接好数据源，可以进行正常的邮件合并

Dim myMerge As MailMerge, i As Integer, myname As String, curPath As String

Application.ScreenUpdating = False

curPath = ActiveDocument.Path

Set fso = CreateObject("scripting.filesystemobject")

    If (fso.folderexists(curPath & "\拆分后文档")) Then

     Else

       Set f1 = fso.createfolder(curPath & "\拆分后文档")

     End If

Set myMerge = ActiveDocument.MailMerge

With myMerge.DataSource

    If .Parent.State = wdMainAndDataSource Then

        .ActiveRecord = wdFirstRecord

        For i = 1 To .RecordCount

            .FirstRecord = i

            .LastRecord = i

            .Parent.Destination = wdSendToNewDocument

            '取得数据源第1个和第2个字段（合并域）的当前数据字符串，用以命名文件

            myname = .DataFields(1).Value

            .ActiveRecord = wdNextRecord

            .Parent.Execute  '每次合并一个数据记录

            With ActiveDocument

                .Content.Characters.Last.Previous.Delete  '删除分节符

                .SaveAs curPath & "\拆分后文档\" & myname '生成的各文档保存目录

                .Close  '关闭生成的文档（已保存）

            End With

        Next

    End If

End With

Application.ScreenUpdating = True

MsgBox "拆分操作完毕!" & vbCrLf & "请到本目录下“拆分后文档”文件夹查看！！", vbInformation

End Sub

二、不使用“邮件合并分布向导”

1、在Word邮件功能区，选择收件人→使用现有列表→浏览到Excel文件，如下：

2、在Word文档相应位置插入Excel中的数据域，如下：

3、然后就可以在“邮件”功能区或代码生成Word文档，如下：

三、Word从Excel中获取数据生成文档

1、编辑当前Word文档，切换到“插入”功能区，文本→文档部件→域，如下：

2、找到DOCVARIABLE域，在“新名称”输入Name，如下：

插入域的另一种方式：在相应位置按Ctrl+F9，里面输入 DOCVARIABLE Name。如下：

3、按上步依次在相应位置插入DOCVARIABLE域，新名称为Number、Date，插入所有域后，打开vba输入如下代码：

Sub vba当前Word设置域获取Excel数据生成文档()

' 打开 Data.xlsx 文件

    Dim MyFile As Object

    Set MyFile = CreateObject("Scripting.FileSystemObject")

    Dim FilePath As String

    FilePath = ActiveDocument.Path & "\Data.xlsx"

    ' 如果不存在 Data.xlsx 文件

    If Not MyFile.FileExists(FilePath) = True Then

        ' 退出

        MsgBox "无法找到文件: Data.xlsx", Title:="Error"

        Exit Sub

    End If

    ' 读取 Data.xlsx 文件

    Dim ExcelObject As Object

    Set ExcelObject = GetObject(FilePath)

    Set Table = ExcelObject.Sheets(1).UsedRange()

    ' 循环

    For i = 1 To Table.Rows.Count

        ' 清空变量

        For Each Var In ActiveDocument.Variables

            Var.Delete

        Next

        ' 添加一个名字为 Name 的变量，它的值是 Data.xlsx 中第 i 行第 1 列的内容

        ActiveDocument.Variables.Add Name:="Name", Value:=Table.Cells(i, 1).Text

        ' 添加一个名字为 Number 的变量，它的值是 Data.xlsx 中第 i 行第 2 列的内容

        ActiveDocument.Variables.Add Name:="Number", Value:=Table.Cells(i, 2).Text

        ' 添加一个名字为 Date 的变量，它的值是 Data.xlsx 中第 i 行第 3 列的内容

        ActiveDocument.Variables.Add Name:="Date", Value:=Table.Cells(i, 3).Text

        ' 更新 Word 文档

        ActiveDocument.Fields.Update

        ' 设置保存目录

        ChangeFileOpenDirectory ActiveDocument.Path

        ' 保存文件，文件名为：姓名.docx

        ActiveDocument.SaveAs2 FileName:=Table.Cells(i, 1).Text & ".docx", FileFormat:= _

                               wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _

                                                                                     :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _

                                                                                                                                          :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _

                               SaveAsAOCELetter:=False, CompatibilityMode:=15

    Next

End Sub

可交流分享经验，联系qq：329876601