场景：

我们的采购信息存储在excel中，需要以合同编号为基准，批量生成多个word采购合同。

采购合同样本如下：

实现方法和步骤：

通常这种可以使用邮件合并来完成，但是涉及多条信息拆分到word中的时候，邮件合并就不好使了。所以这里，我们用Excel魔方插件来实现。

我们先对word采购合同做一些整理：

模板中，需要替换的字段，这么标识：
Excel中列名是姓名，到Word里面就要改成【姓名】，以此类推。
多条明细内容，需要单独加明细二字：
Excel中列名是规格型号，到Word里面就要改成【规格型号】明细，以此类推。

接着，打开插件按钮

配置好模板路径以及excel明细数据的区域

执行完之后结果如下：

其中用到了excel vba和wordvba的知识。

Sub 写入Word数据()
Application.ScreenUpdating = False
Set doc = CreateObject("word.application")
doc.Visible = True
kehu_row = ActiveSheet.Cells(Rows.Count, 3).End(3).Row '找到C列已使用的最大行号，客户名称所在列
For i = 2 To kehu_row '开始对C列进行循环
If Cells(i, 3) <> "" And Cells(i + 1, 3) = "" Then '当是最后一行的情况的时候
r = Cells(i, 3).End(xlDown).Row - 1 '获取第三列此时的最大行号-1
If r = Rows.Count - 1 And r <> Cells(i, 4).End(xlDown).Row - 1 Then '该客户有多个商品
r = Cells(i, 4).End(xlDown).Row '第四列已使用的最大行号赋值给r
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 '如果r<>i，也就是说，该客户不止一件商品，word表格插入行
For rr = 2 To r - i + 2 '开始往word表格中写入数据
.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

Excel明细生成多个word采购合同，Excel魔方完成相关推荐

excel明细生成多个word文档，比邮件合并好用100倍。
需求:把excel明细批量生成word文档,每条明细生成1个文档. 将上面的WIFI用户名.密码填到word文档中相应位置,并且需要插入图片. 通常用的是word邮件合并功能,但是步骤多,麻烦.插件简 ...
excel转word_PDF一键转Word、转Excel、转PPT、转Html、转图片软件
还没关注,伸出手指点这里 PDF文件是我们在生活或工作中经常会碰到的,相信很多人都遇到过要把 PDF 转成 Word 的需求,可默认无法编辑的 PDF 文件,难倒了很多人! 在万能的淘bao搜索&qu ...
根据Apache Poi写了个基于Web的Excel文件生成工具
不废话直接上代码 /**** Excel文件生成类* 工具包POI*/ public class ExcelUtils {/*** 创建workBook* @return*/public static ...
如何通过excel批量生成word文件？
如何通过excel批量生成word文件?不知道大家有没有面对过批量生成word文件的工作经历,相信有很多小伙伴都遇到过,一个excel表格里实事先准备好了很多文件名称,然后一次性通过这些文件名称生成对 ...
java excel转pdf linux,从JAVA直接读取EXCEL、WORD并生成PDF文件
从JAVA直接读取EXCEL.WORD并生成PDF文件 1.操作EXCEL和WORD文件使用JAVA从EXCEL.WORD文件中读写数据,可以使用http://jexcelapi.sourcefor ...
Excel转Word，Excel导出Word，利用Excel表批量生成Word文档，邮件合并进阶版
单击播放视频教材利用Excel数据批量生成Word文档升级版,Excel转W 01需求概述假设有图1所示的数据,需要批量生成WORD成绩通知单,通知单必须遵循图2的样式. (案例中的姓名.学校名称 ...
EXCEL附注生成WORD附注（XLS2DOC) 下载
EXCEL附注生成WORD附注工具前后历经十年左右的时间,不停的迭代,不停地修正,基本上是一个比较成形的工具了.能为注册会计师.审计人员.财务人员省下复制粘贴的大量时间,专心于审计实务. 目前我申请了 ...
把Excel数据填充word模板生成多份word文档
有些事情,你想记得的就会记得.有些事情,你想忘记的就会忘记,如果忘记不了,那就不要忘记了,因为忘记是不需要努力的. Model_Car.cs代码 public class Model_Car{publ ...
外贸采购合同管理经常遇到问题要怎么解决
外贸公司在对采购合同的签订与管理方面,经常会遇到的一个问题,就是一个外销合同,会同时对应多个工厂进行采购的情况.对于这个情况,公司的采购员通常会犯的一个错误,就是漏采购.少采购.多采购等.这样的问题其 ...

Excel明细生成多个word采购合同，Excel魔方完成

场景：

实现方法和步骤：

Excel明细生成多个word采购合同，Excel魔方完成相关推荐

最新文章

热门文章