如何利用Excel表格中的数据批量生成文档？

Question

我需要批量制作一批Word文档，文档内容除了一些数据其他都一致。数据有一个汇总表格。
如果一个个对应数据去修改文档的话工作量太大了，而且还容易出错。想问一下怎么操作可以批量制作Word文档啊。

Answer 1

万能的vba可以实现。下面这段代码所实现的功能就是从EXCEL读取数据后批量生成WORD文档的。
Dim gjzArr(1 To 100, 1 To 2) '1-关键字 2-值
Dim gjzGs As Integer
Dim gjzZD 'key-关键字 item-序号
Sub scbG(x As Integer)
On Error GoTo err
Dim lastHH As Integer
Dim I As Integer, J As Integer
Dim MB As String
Dim TName As String
Dim hzMc As String
Dim wordApp
Dim myDoc
Dim Str1 As String, Str2 As String
Application.ScreenUpdating = False
gjzGs = 0
Set gjzZD = CreateObject("SCRIPTING.DICTIONARY")
'读取B列的值
Call dqsJ(2)
'读取D列的值
Call dqsJ(4)
'读取F列的值
Call dqsJ(6)
MB = Trim(Range("P2").Text)
hzMc = Split(MB, ".")(1)
TName = ThisWorkbook.Path & "\报告\" & gjzArr(gjzZD("B7"), 2) & "." & hzMc
FileCopy MB, TName
Set wordApp = CreateObject("word.application")
wordApp.Visible = True
Set myDoc = wordApp.DOCUMENTS.Open(TName)
myDoc.Unprotect Password:="123456"
myDoc.Activate
With wordApp.ActiveWindow.View
.ShowRevisionsAndComments = False
.RevisionsView = wdRevisionsViewFinal
End With
Dim Bj As Boolean
With wordApp
'关键字替换
For J = 1 To gjzGs '
Str1 = "&" & gjzArr(J, 1) & Space(1)
Str2 = gjzArr(J, 2)
Bj = True
Do While Bj
.Selection.HomeKey Unit:=wdStory '光标置于文件首
If .Selection.Find.Execute(Str1) Then '查找到指定字符串
.Selection.Text = Str2 '替换字符串
Else
Bj = False
End If
Loop
Next J
End With
'写入表格内容
Dim myTable
'表一填写
Set myTable = myDoc.Tables(1)
myTable.Range.Cells(2).Range.Text = gjzArr(gjzZD("B24"), 2) '房屋权证号
myTable.Range.Cells(4).Range.Text = gjzArr(gjzZD("B20"), 2) '房屋所有权人
myTable.Range.Cells(6).Range.Text = gjzArr(gjzZD("B26"), 2) '产别
myTable.Range.Cells(8).Range.Text = gjzArr(gjzZD("B21"), 2) & gjzArr(gjzZD("B22"), 2) & gjzArr(gjzZD("B23"), 2) '房屋坐落
myTable.Range.Cells(18).Range.Text = gjzArr(gjzZD("B27"), 2) '幢号
myTable.Range.Cells(19).Range.Text = gjzArr(gjzZD("B28"), 2) '房号
myTable.Range.Cells(21).Range.Text = gjzArr(gjzZD("B29"), 2) '总层数
myTable.Range.Cells(22).Range.Text = gjzArr(gjzZD("B30"), 2) '所在层数
myTable.Range.Cells(23).Range.Text = gjzArr(gjzZD("B31"), 2) '建筑面积
myTable.Range.Cells(27).Range.Text = gjzArr(gjzZD("B25"), 2) '房屋共有人
If myDoc.Revisions.Count >= 1 Then myDoc.Revisions.AcceptAll
myDoc.Protect Password:="123456", NoReset:=False, Type:=wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False
myDoc.Save
myDoc.Close
wordApp.Quit
Application.ScreenUpdating = True
MsgBox ("报告已经完成")
Exit Sub
err:
MsgBox ("同名文件已经打开，请关闭后重新运行！")
End Sub
Sub dqsJ(Lh As Integer)
Dim lastHH As Integer
If Lh <= 1 Then
MsgBox ("不可选择小于等于1的列")
Exit Sub
End If
lastHH = Cells(1000, Lh - 1).End(xlUp).Row
For I = 1 To lastHH
If Trim(Cells(I, Lh - 1).Text) <> "" Then
gjzGs = gjzGs + 1
myT1 = Replace(Cells(I, Lh).Address, "$", "")
myT2 = Cells(I, Lh).Text
gjzZD.Add myT1, gjzGs
gjzArr(gjzGs, 1) = myT1
gjzArr(gjzGs, 2) = myT2
End If
Next I
End Sub

Answer 2

如果是规则的baiEXCEL，想通过手工操作的话，可以du用邮件合并方式。生成一个zhiWORD文档。有关邮dao件合并，请看WORD中，工具-信函与函件中，不过一般操作的时候，如果不熟手，很可能不成功。第二种方式，是用程序代码来生成，写在WORD中或者EXCEL中都可以，如果经常要做这样的工作，可以采用第二种方式，请人写代码。如果经常要操作，格式固定，办公人员的话，学会邮件合并是很有用的。