Excel自动生成word合同(怎么用word做合同)

之前有两篇文章讲过Excel和Word数据交互的基础知识Excel和Word数据交互读取（一）和Excel和Word数据交互读取（二），这里说个实际代工遇到的案例。

一、实际案例引入

这次遇到的案例需求：Excel数据批量写入Word，生成合同文书。数据的对应关系如下图截图中所示。

数据对应关系

二、思路及代码

思路很重要，代码可以不看，循环思路一定要看！

■思路：Word合同作为打开的模板文件，循环Excel数据写入Word，然后另存为新的Word文件。难点在于，每一个客户不一定只有一个产品订单。下面是代码循环的结构流程图。

具体代码如下：

Sub 写入Word数据() Application.ScreenUpdating = False Set doc = CreateObject("word.application") doc.Visible = True id_row = ActiveSheet.Cells(Rows.Count, 4).End(3).Row kehu_row = ActiveSheet.Cells(Rows.Count, 3).End(3).Row For i = 2 To kehu_row If Cells(i, 3) <> "" And Cells(i + 1, 3) = "" Then r = Cells(i, 3).End(xlDown).Row - 1 If r = Rows.Count - 1 And r <> Cells(i, 4).End(xlDown).Row - 1 Then r = Cells(i, 4).End(xlDown).Row ElseIf r = Rows.Count - 1 And r = Cells(i, 4).End(xlDown).Row - 1 Then r = i End If Set wd = doc.Documents.Open(ThisWorkbook.Path & "合同模板.docx") With doc.Documents(1).Tables(1) .Rows(2).Select If r <> i Then doc.Selection.insertrowsbelow r - i For rr = 2 To r - i + 2 .cell(rr, 1).Range = IIf(Cells(i + rr - 2, 5).Value = "", "", Cells(i + rr - 2, 5).Value) .cell(rr, 2).Range = IIf(Cells(i + rr - 2, 6).Value = "", "", Cells(i + rr - 2, 6).Value) .cell(rr, 3).Range = IIf(Cells(i + rr - 2, 7).Value = "", "", Cells(i + rr - 2, 7).Value) .cell(rr, 4).Range = IIf(Cells(i + rr - 2, 8).Value = "", "", Cells(i + rr - 2, 8).Value) .cell(rr, 5).Range = IIf(Cells(i + rr - 2, 9).Value = "", "", Cells(i + rr - 2, 9).Value) .cell(rr, 6).Range = IIf(Cells(i + rr - 2, 10).Value = "", "", Cells(i + rr - 2, 10).Value) .cell(rr, 7).Range = IIf(Cells(i + rr - 2, 11).Value = "", "", Cells(i + rr - 2, 11).Value) .cell(rr, 8).Range = IIf(Cells(i + rr - 2, 12).Value = "", "", Cells(i + rr - 2, 12).Value & "％") Next .cell(rr, 2).Range = WorksheetFunction.Sum(Range(Cells(i, 8), Cells(r, 8))) .cell(rr, 5).Range = WorksheetFunction.Sum(Range(Cells(i, 11), Cells(r, 11))) End With Set myrange = wd.Content With doc.Selection .HomeKey Unit:=6 .Find.Execute ("日期数据1") .Text = Cells(i, 1).Value .HomeKey Unit:=6 .Find.Execute ("日期数据2") .Text = Cells(i, 1).Value .HomeKey Unit:=6 .Find.Execute ("需方数据") .Text = Cells(i, 3).Value .HomeKey Unit:=6 .Find.Execute ("总金额数据") .Text = Cells(i, 13).Value .HomeKey Unit:=6 .Find.Execute ("甲方数据1") .Text = Cells(i, 3).Value .HomeKey Unit:=6 .Find.Execute ("甲方数据2") .Text = Cells(i, 3).Value End With doc.ActiveWindow.ActivePane.View.SeekView = 9 doc.Selection.HomeKey Unit:=6 If doc.Selection.Find.Execute("合同编号数据") Then doc.Selection.Text = Cells(i, 2).Value End If doc.Selection.Find.Execute Replace:=2 doc.Selection.HomeKey Unit:=6 fpath = ThisWorkbook.Path & "" & Cells(i, 2).Value & "静载合同.docx" wd.SaveAs fpath wd.Close False ElseIf Cells(i, 3) <> "" And Cells(i + 1, 3) <> "" Then Set wd = doc.Documents.Open(ThisWorkbook.Path & "合同模板.docx") With doc.Documents(1).Tables(1) .cell(2, 1).Range = Cells(i, 5).Value End With Set myrange = wd.Content With doc.Selection .HomeKey Unit:=6 .Find.Execute ("日期数据1") .Text = Cells(i, 1).Value .HomeKey Unit:=6 .Find.Execute ("日期数据2") .Text = Cells(i, 1).Value .HomeKey Unit:=6 .Find.Execute ("需方数据") .Text = Cells(i, 3).Value .HomeKey Unit:=6 .Find.Execute ("总金额数据") .Text = Cells(i, 13).Value .HomeKey Unit:=6 .Find.Execute ("甲方数据1") .Text = Cells(i, 3).Value .HomeKey Unit:=6 .Find.Execute ("甲方数据2") .Text = Cells(i, 3).Value End With doc.ActiveWindow.ActivePane.View.SeekView = 9 doc.Selection.HomeKey Unit:=6 If doc.Selection.Find.Execute("合同编号数据") Then doc.Selection.Text = Cells(i, 2).Value End If doc.Selection.Find.Execute Replace:=2 doc.Selection.HomeKey Unit:=6 fpath = ThisWorkbook.Path & "" & Cells(i, 2).Value & "静载合同.docx" wd.SaveAs fpath wd.Close False Else End If Next doc.Quit Application.ScreenUpdating = True MsgBox "完成！" End Sub

三、知识点

■Find对象（方法）

●作为Selection对象的方法

下例查找并选择出现的下一个"hi"单词。

With Selection.Find .ClearFormatting .Text = "hi" .Execute Forward:=True End With

●作为对象

以下示例在活动文档中查找所有“hi”并将其替换为“hello”。

Set myRange = ActiveDocument.Content myRange.Find.Execute FindText:="hi", ReplaceWith:="hello", _ Replace:=wdReplaceAll

上面例子中用到了Find对象的Execute 方法需要重点说一说，这个方法有点强大：

Find.Execute 方法

作用：运行指定的查找操作。如果查找成功，则返回 True。

语法：表达式.Execute(FindText、 MatchCase、 MatchWhole-Word、 MatchWildcards、 MatchSoundsLike、 MatchAllWordForms、 Forward、 Wrap、 Format、 ReplaceWith、 Replace、 MatchKashida、 MatchDiacritics、 MatchAlefHamza、 MatchControl)

其中表达式是一个Find 对象变量，是必须的。各个参数的含义及适用范围如下：

双击查看大图

■新建表格，插入行

代码中涉及到新建表格并插入行写入数据的地方，这里给一个简单的例子作为参考。（这个代码直接在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

代码运行效果如下：