|
之前有两篇文章讲过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
代码运行效果如下：
■HomeKey 方法 作用：将所选内容移动或扩展到指定单位的开头。此方法对应于 HOME 键的功能。 语法：expression.HomeKey( Unit , Extend ) 
下面代码将当前光标移到文档的开头。如果光标在表格中，则将光标移至表格第一个单元格。（为了Find从头开始查找） Selection.HomeKey Unit:=wdStory, Extend:=wdMove
在Excel中若要操作Word，需要将参数换成数值。所以我在代码中写成HomeKey Unit:=6。
|
