很多時候，您是否有過在WORD里面重復制作某種資料的工作。比如給定了合同模板，需要根據不同合同內容制作出不同的合同，但模板是一樣的。一般情況下就是老老實實的一份一份的去填寫（還不保證不會有錯誤）。那么有沒有可以自動生完成的辦法呢？答案是肯定有，不然我在這嗶嗶啥呢！接下來言歸正傳。在此上個大招，接下來就以合同為例：

1、制作合同模板文件，把合同變量部分用特殊變量替換。圖示如下：

?

2、在EXCEL里面添加合同主要內容數據，圖示如下：

?

3、在EXCEL里面添加一個Active X按鈕控件，根據自身需要修改其屬性。

?

4、.在按鈕控件下寫如下代碼，并將該EXCEL文件另存為XLSM：

 Private Sub cmd_makedoc_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_NO As String
 Dim side_A As String
 Dim side_B As String
 i = ActiveCell.Row
 contact_NO = Cells(i, 1)
 side_A = Cells(i, 2)
 side_B = Cells(i, 3)
 
 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 = "{$合同編號}"
 .Replacement.Text = contact_NO
 End With
 .Find.Execute Replace:=wdReplaceAll
 
 With .Find
 .Text = "{$甲方}"
 .Replacement.Text = side_A
 End With
 .Find.Execute Replace:=wdReplaceAll
 
 With .Find
 .Text = "{$乙方}"
 .Replacement.Text = side_B
 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

核心技術部分完畢，那么如何使用呢？

1、單擊選定需要輸出數據制作合同的行的任意單元格。比如我在此選定了第一行中的B2單元格，當然你可以選擇該行的任意一單元格。

?

2、單擊“生成”按鈕，彈出合同模板選擇對話框。在此，選擇我們剛才制作好的合同模板。

?

3、打開應用該模板，然后隨之彈出生成后的合同另存為的對話框。這里文件名會被自動保存為合同編號。

?

4、生成完畢。以下是效果

?

以上是拋磚引玉的一個辦法，僅需對代碼中需要替換的部分進行更改，那么基本上可以做到復雜的輸出。實際上技術難度沒多大，僅僅是利用了Office里面的宏替換原理而已。經過改造，在實際的生產環境中，可以利用EXCEL從其它系統獲取數據，然后再批量制作各種WORD文檔。