调用excel数据自动生成word文档

标签：Dim word String Text excel Find 文档 End side

应用场景：相信很多时候，您是否有过和博主一样在WORD里面重复制作某种资料的工作。比如给定了一份模板，需要根据不同内容制作出不同的word，但模板是一样的。一般情况下就是老老实实的一份一份的去填写（但人力填写难保证不出错，精力有限）。那么有没有可以自动生完成word的办法呢？答案是肯定有，接下来就以输出一份计算书为例：

工具

本次以博主电脑在用的excel365为例，用VBA调用word控件替换word中。

步骤

1. 首先要有word模板吧；其中需要替换的数据采用特殊变量替换。图示如下：

PS：图中均用{%xxx}的形式表示需要替换的特殊变量。

2. excel里面的添加需要输出的内容数据。图示如下：

PS：图中博主需要输出的数据为标黄色的那列。

3. EXCEL里面打开开发者模式（毕竟要写点代码）。

4. 在EXCEL里面添加一个Active X按钮控件，根据自身需要修改其属性。

5. 打开EXCEL里的VBA编辑器；选择“工具”—“引用”，然后打开加载文件选择框，选择“Microsoft Word16.0 Object Library”这个项目，如下图：

PS：Word项目“Microsoft Word16.0 Object Library”这个必须引用起来，否则后期在执行变量替换时，VBA无法调用Word替换功能。

6. 在刚才加的按钮控件下写如下代码，并将该EXCEL文件另存为XLSM：

Private Sub CommandButton1_Click()
On Error GoTo Err_cmdExportToWord_Click
    Dim objApp As Object 'Word.Application
    Dim objDoc As Object 'Word.Document
    Dim strTemplates As String '模板文件路径名
    Dim strFileName As String '将数据导出到此文件
    Dim i As Integer
    Dim contact_dew As String
    Dim contact_area As String
    Dim contact_flood As String
    Dim side_1 As String
    Dim side_2 As String
    Dim side_3 As String
    Dim side_4 As String
    Dim side_5 As String
    Dim side_6 As String
    Dim side_7 As String
    Dim side_8 As String
    Dim side_9 As String
    Dim side_11 As String
    Dim side_12 As String
    Dim side_13 As String
    Dim side_14 As String

    i = ActiveCell.Column
    contact_dew = Cells(4, i)
    contact_area = Cells(5, i)
    contact_flood = Cells(6, i)
    side_1 = Cells(7, i)
    side_2 = Cells(8, i)
    side_3 = Cells(9, i)
    side_4 = Cells(10, i)
    side_5 = Cells(11, i)
    side_6 = Cells(12, i)
    side_7 = Cells(13, i)
    side_8 = Cells(15, i)
    side_9 = Cells(16, i)
    side_10 = Cells(17, i)
    side_11 = Cells(18, i)
    side_12 = Cells(19, i)
    side_13 = Cells(23, i)
    side_14 = Cells(24, i)
 
    With Application.FileDialog(msoFileDialogFilePicker)
         .Filters.Add "word文件", "*.doc*", 1
         .AllowMultiSelect = False
         If .Show Then strTemplates = .SelectedItems(1) Else Exit Sub
    End With

  '通过文件对话框生成另存为文件名
    With Application.FileDialog(msoFileDialogSaveAs)
        '.InitialFileName = CurrentProject.Path & "\" & contact_NO & ".doc"
        .InitialFileName = contact_NO & ".doc"
        If .Show Then strFileName = .SelectedItems(1) Else Exit Sub
    End With

    '文件名必须包括“.doc”的文件扩展名，如没有则自动加上
    If Not strFileName Like "*.doc" Then strFileName = strFileName & ".doc"
    '如果文件已存在，则删除已有文件
    If Dir(strFileName) <> "" Then Kill strFileName
    '打开模板文件
    Set objApp = CreateObject("Word.Application")
    objApp.Visible = True
    Set objDoc = objApp.Documents.Open(strTemplates, , False)
 
  '开始替换模板预置变量文本
   With objApp.Application.Selection
        .Find.ClearFormatting
        .Find.Replacement.ClearFormatting
        With .Find
             .Text = "{%dew}"
             .Replacement.Text = contact_dew
        End With
        .Find.Execute Replace:=wdReplaceAll
 
        With .Find
             .Text = "{%area}"
             .Replacement.Text = contact_area
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%fl}"
             .Replacement.Text = contact_flood
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%qcda}"
             .Replacement.Text = side_1
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%qcda1}"
             .Replacement.Text = side_2
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%vf}"
             .Replacement.Text = side_3
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%dp}"
             .Replacement.Text = side_4
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%op}"
             .Replacement.Text = side_5
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%cpd}"
             .Replacement.Text = side_6
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%spd}"
             .Replacement.Text = side_7
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%mpl}"
             .Replacement.Text = side_8
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%mpf}"
             .Replacement.Text = side_9
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%twl}"
             .Replacement.Text = side_10
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%twf}"
             .Replacement.Text = side_11
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%twd}"
             .Replacement.Text = side_12
        End With
        .Find.Execute Replace:=wdReplaceAll
        
        With .Find
             .Text = "{%mplo}"
             .Replacement.Text = side_13
        End With
        .Find.Execute Replace:=wdReplaceAll
 
       With .Find
            .Text = "{%twpl}"
            .Replacement.Text = side_14
       End With
       .Find.Execute Replace:=wdReplaceAll
    End With
 
    '将写入数据的模板另存为文档文件
    objDoc.SaveAs strFileName
    objDoc.Saved = True
    MsgBox "计算书生成完毕", vbYes + vbExclamation
Exit_cmdExportToWord_Click:
    If Not objDoc Is Nothing Then objApp.Visible = True
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objTable = Nothing
    Exit Sub
Err_cmdExportToWord_Click:
    MsgBox Err.Description, vbCritical, "出错"
    Resume Exit_cmdExportToWord_Click
End Sub

7.技术部分搞定了，那么咋滴使用呢？

1.单击选定需要输出数据制作合同的行的任意单元格。这个案例中我在此选定了第一行中的F4单元格，当然你可以选择该行的任意一列单元格。此处对应代码块中的

i = ActiveCell.Column

即将excel当前激活的单元格的列数赋值给i这个变量。

PS：同样的，也有“i = ActiveCell.Row”，就是将excel当前激活的单元格的行数赋值给i这个变量。

PPS：excel中激活的单元格就是随便点个位置就表示你“激活”了这个随便点的单元格子。

PPPS：当然也可以使用excel单元格的绝对位置进行赋值。

单击“CommandButton1”按钮，弹出合同模板选择对话框。在此，选择我们刚才制作好的合同模板。

打开应用该模板，然后随之弹出生成后的文件另存为的对话框。这里填写所保存文件名。
生成完毕。以下是效果

后记

以上仅是一个办法，仅需对代码中需要替换的部分进行更改，那么基本上可以做到复杂的输出。实际上技术难度没多大，代码看似挺多，其实很多为变量替换而已，可根据需要自行改造，在实际的生产环境中，可以利用EXCEL从其它的数据系统获取数据，然后再批量制作多种多样WORD文档。

后续有时间的话考虑更新在现有功能上插入图片，并根据模板的图片大小自动调整其插入图片的大小。

标签：Dim,word,String,Text,excel,Find,文档,End,side
From： https://www.cnblogs.com/dravenaxe/p/17702160.html