请教高手--怎样利用excel数据批量生成word文档

leftalfa

手中有一批数据 要批量生成word文档，一组数据一个word文档。请教高手如何解决？非常感谢。
举个例子：

excel源数据：




word模板：



生成后第一个word：



附件

excel数据 word模板.rar (36.45 KB, 下载次数: 267)

2012-5-25 23:42 上传

点击文件名下载附件
附件excel数据

xsy我可以很好

用邮件合并

qinlei1024

邮件合并功能能满足要求

sscylh

典型的邮件合并!

leftalfa

我试着弄了一下 不过 所有的数据都合并到了一个word中，不知道有没有办法 一条记录生成一个word。这样有多少条记录，就可以生成多少个word。

请教高手们。

武松打鼓

好像用monkey朋友的模板可以

z9bhd

闲来没事，找些旧贴练练手
数据量较大，运行时要耐心等待
Sub lx()
    Dim ar, wdapp As Object, mwd As Object, nwd As Object, i%, j%, k%
        Application.ScreenUpdating = False
        ar = Sheet1.UsedRange
        Set wdapp = CreateObject("word.application")
        wdapp.Visible = True
        Set mwd = wdapp.documents.Open(ThisWorkbook.Path & "\word模板.doc")
         mwd.Range.Copy
        On Error Resume Next
        If Dir(ThisWorkbook.Path & "\拆分文件\") = "" Then MkDir (ThisWorkbook.Path & "\拆分文件")
        For i = 2 To UBound(ar)
            If InStr(ar(i, 2), Chr(10)) > 0 Then ar(i, 2) = Replace(ar(i, 2), Chr(10), "")
            If InStr(ar(i, 2), " ") > 0 Then ar(i, 2) = Replace(ar(i, 2), " ", "")
            Set nwd = wdapp.documents.Add
            nwd.Range.Paste
            With nwd
                .Paragraphs(2).Range.Text = Replace(.Paragraphs(2).Range.Text, "AA", ar(i, 2))
                .tables(1).Range.Cells(2).Range.Text = ar(i, 3)
                .tables(2).Range.Cells(2).Range.Text = ar(i, 6)
                .tables(2).Range.Cells(4).Range.Text = ar(i, 5)
                .tables(2).Range.Cells(6).Range.Text = ar(i, 4)
            End With
            nwd.SaveAs (ThisWorkbook.Path & "\拆分文件\" & ar(i, 1) & "-" & ar(i, 2) & ".docx")
            nwd.Close
        Next i
        mwd.Close 0
        Application.ScreenUpdating = True
End Sub

jjamxin

daibao88

需要先期引用

jjamxin

daibao88 发表于 2021-7-3 11:21
需要先期引用

谢谢