通过表格数据填充模版并打印

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, j&, r&, wdApp As Word.Application, strFileName$, strPath$, strSaveName$
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "打印模版.docx"
    If Dir(strFileName) = "" Then MsgBox "模板文件不存在，请检查！", vbExclamation: Exit Sub
   
    Application.ScreenUpdating = False
    r = Cells(Rows.Count, "D").End(xlUp).Row
    ar = Range("D1:G" & r).Value
   
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = New Word.Application
    End If
   
    For i = 2 To UBound(ar)
        With wdApp.documents.Open(strFileName)
            strSaveName = strPath & Format(Date, "yyyymmdd") & ar(i, 1)
            For j = 1 To UBound(ar, 2)
                With .Content.Find
                   .ClearFormatting
                   .Text = ar(1, j)
                   .Replacement.ClearFormatting
                   .Replacement.Text = ar(i, j)
                   .Execute Replace:=wdReplaceAll
                End With
            Next j
            .PrintOut
            .SaveAs2 strSaveName
            .Close
        End With
    Next i
      
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

pfcszp

gwjkkkkk 发表于 2024-8-14 21:45
请参考。。。

感谢，感谢