如何批量生成Word通知单？

gdqyboy

请教各位大佬：

      如何使用Excel VBA从表格的数据填入到Word模板中，每一行数据生成一页。请帮助修改表中的代码，感谢！

明天会更好zj

这种首选邮件合并，没必要用VBA代码

3190496160

Sub 生成word文档()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim i%, ar, myPath$, wdApp, wdd
Dim oFso
Set oFso = CreateObject("Scripting.FileSystemObject")
myPath = ThisWorkbook.Path & "\"
wj = myPath & "欠费通知函.docx"
f = Dir(wj)
If f = "" Then MsgBox "找不到欠费通知函.docx，请核查后重试！": End
Set wdApp = CreateObject("word.application")
wdApp.Visible = True
With Sheets("a")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs < 3 Then MsgBox "数据源为空！": End
    ar = .Range("A2:e" & rs)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 2)) <> Empty Then
        FileCopy myPath & f, myPath & "通知单\" & ar(i, 2) & "-欠费通知函.docx"
        Set wdd = wdApp.Documents.Open(myPath & "通知单\" & ar(i, 2) & "-欠费通知函.docx")
        With wdApp.Selection
            .HomeKey unit:=6 '光标置于文件首
            If .Find.Execute("sj1") Then '查找到指定字符串
                .Font.Color = wdColorAutomatic '字符为自动颜色
                .Text = ar(i, 2) '替换字符串
            End If
        End With
        With wdApp.Selection
            .HomeKey unit:=6 '光标置于文件首
            If .Find.Execute("sj2") Then '查找到指定字符串
                .Font.Color = wdColorAutomatic '字符为自动颜色
                .Text = ar(i, 5) '替换字符串
            End If
        End With
        wdd.Close True
    End If
Next i
wdApp.Quit
Set wdd = Nothing
Set wdApp = Nothing
Set oFso = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "通知单已生成完毕！", vbInformation
End Sub

3190496160

附件.rar (28.23 KB, 下载次数: 40)

2024-2-25 09:26 上传

点击文件名下载附件

gwjkkkkk

标准邮件合并。。。

lizhipei78

https://club.excelhome.net/thread-1674623-1-1.html

gdqyboy

3190496160 发表于 2024-2-25 09:26

谢谢啦。但我要生成多页的Word文件呢，不是每个客户一个文件呀。

过客fppt

参与一下

3190496160

gdqyboy 发表于 2024-2-25 17:02
谢谢啦。但我要生成多页的Word文件呢，不是每个客户一个文件呀。

呵呵呵，那还折腾什么代码呢？直接邮件合并也是秒秒钟的事情

过客fppt

无聊练习一下


效果