请教个将花名册里的人员信息表导入到劳动合同并生成新的文件

雁咚天

看附件21313213132

许仙123

这个好像要用WORD里的邮件合并功能，不是EXCEL

3190496160

这个问题，用代码也可以完成，但是，觉得没有必要用代码，邮件合并分分钟钟完成呀

雁咚天

3190496160 发表于 2023-3-24 11:10
这个问题，用代码也可以完成，但是，觉得没有必要用代码，邮件合并分分钟钟完成呀

谢谢。我搜索了下邮件合并，果然可以。

3190496160

Sub 批量word()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")   '新建Word对象
Dim wdd
t = Timer
Dim ar As Variant
lj = ThisWorkbook.Path
mb = lj & "\浙江益新机械股份有限公司劳动合同2.docx"
ar = ActiveSheet.[a1].CurrentRegion
wdApp.Visible = False
For i = 2 To UBound(ar)
    If Len(Trim(ar(i, 2))) > 0 Then
        wj = ar(i, 2)
        FileCopy mb, lj & "\" & wj & ".docx"
        Set wdd = wdApp.Documents.Open(lj & "\" & wj & ".docx")
        For j = 2 To UBound(ar, 2)
            With wdApp.Selection
                .HomeKey unit:=6 '光标置于文件首
                If .Find.Execute("数据" & j - 1) Then '查找到指定字符串
                    .Font.Color = wdColorAutomatic '字符为自动颜色
                    .Text = ar(i, j) '替换字符串
                End If
            End With
        Next j
        wdd.Save
        wdd.Close True
    End If
Next i
wdApp.Quit
Set wdd = Nothing
Set wdApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "耗时：" & Format(Timer - t, "0.00") & "秒"
End Sub

3190496160

3190496160

劳动合同22.rar (41.9 KB, 下载次数: 28)

2023-3-24 11:22 上传

点击文件名下载附件