求助万能的大神，怎么把excel中的数据通过VBA自动导入到word中（word可以做一个模...

xiaOdcc

求助万能的大神，怎么把excel中的数据通过VBA自动导入到word中（word可以做一个模板，根据excel表中的人数自动在同一个word中生成多个人的信息），包括把每个人的证书荣誉图片也导入到相应的个人信息下面。

3190496160

Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")   '新建Word对象
wdApp.Visible = True
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:f" & r)
End With
lj = ThisWorkbook.Path
mb = lj & "\文档.docx"
If Dir(mb) = "" Then MsgBox "找不到文档！": End
t = Timer
Set wdd = wdApp.Documents.Open(mb)
For i = 2 To UBound(ar)
    If Len(Trim(ar(i, 1))) > 0 Then
        m = m + 1
        zf = ""
        If ar(i, 5) <> "" Then
            zf = ar(i, 5)
        End If
        If ar(i, 6) <> "" Then
            If zf = "" Then
                zf = ar(i, 6)
            Else
                zf = zf & "," & ar(i, 6)
            End If
        End If
        zd = ar(i, 1) & "," & Format(ar(i, 2), "yyyy年m月d日") & "出生，" & ar(i, 3) & ",毕业于" & ar(i, 4) & "获得" & zf
        With wdApp.Selection
            .Font.Size = 14
            .EndKey 'Unit:=wdStory '光标置于文件尾
            .Text = "个人简历" & m & Chr(10) & zd
            '.EndKey 'Unit:=wdStory '光标置于文件尾
            '.Text = zd
            f = Dir(lj & "\证书荣誉\*.*g")
            k = 0
            Do While f <> ""
                If InStr(f, ar(i, 1)) > 0 Then
                    k = k + 1
                    tt = lj & "\证书荣誉\" & f
                    .EndKey 'Unit:=wdStory '光标置于文件尾
                    .InlineShapes.AddPicture Filename:=tt, LinkToFile:=False, SaveWithDocument:=True '直接插入
                    'wdd.InlineShapes(k).Height = 535 '调整图片高度
                End If
            f = Dir
            Loop
        End With
        Set f = Nothing
    End If
Next i
wdd.SaveAs Filename:=lj & "\文档" & Format(Date, "yyyymmdd") & ".docx"
wdd.Close
Set wdd = Nothing
Set wdApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "耗时：" & Format(Timer - t, "0.00") & "秒"
End Sub

3190496160

excel数据输出到word中（包括导入图片）.rar (822.32 KB, 下载次数: 11)

2024-6-12 18:07 上传

点击文件名下载附件

3190496160

一个初稿，很多细节未考虑，先看看再说吧

xiaOdcc

3190496160 发表于 2024-6-12 18:08
一个初稿，很多细节未考虑，先看看再说吧

万分感谢

xiaOdcc

xiaOdcc 发表于 2024-6-13 09:54
万分感谢

能不能在word中统发文字信息并导入图片。

lizhipei78

xiaOdcc 发表于 2024-6-13 10:21
能不能在word中统发文字信息并导入图片。

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