Excel表格数据填充到word模板中-Toy模板网

这篇具有很好参考价值的文章主要介绍了Excel表格数据填充到word模板中。希望对大家有所帮助。如果存在错误或未考虑完全的地方，请大家不吝赐教，您也可以点击"举报违法"按钮提交疑问。

这个需求源于要批量生成模板一样的word文档。当然可以直接使用word的邮件合并功能，点菜单就可以实现，示例代码如下：

要使用这些代码，需要引用2个库microsoft word,microsoft office，如果使用到客体界面的话，还要引用microsoft Forms。本代码可以同时利用两个模板生成新的文档。其原理就是查找替换，没啥，减轻工作量。文章来源地址https://www.toymoban.com/news/detail-558555.html

Sub cmdPrinta_Click()
    
    Dim mypath$, mypathN$, aar1
    Dim r1%, r2%, n2%, j%
    
    Dim Wordapp As Word.Application
    Dim WordD As Word.Document      '定义word类
    Set Wordapp = New Word.Application  '这里需要一个新的
    
    'Wordapp.ScreenUpdating =False             '屏幕刷新
    'Set WordD = Wordapp.Documents.Add                  '新建文档
    If Len(txtlujing) > 1 Then
        mypathN = txtlujing
    Else
        mypathN = ThisWorkbook.Path & "\"
    End If
    mypath = ThisWorkbook.Path & "\"
    
    '初始化参数，要替换
    aar1 = Sheets("说明文字").Range("c5:d23")
    tbldata = "sheet1"
    tepdoc1 = "模板1.docx"
    tepdoc2 = "模板2.docx"


    With Wordapp  '这里需要是application
        .Visible = False
        r1 = TextBox1
        r2 = TextBox2
        For n2 = r1 To r2
            '第一个“模板1”,将模板复制并重命名
            Newname = "说明-" & Sheets(tbldata).Range("D" & n2) & "_" & _
                     Sheets(tbldata).Range("B" & n2) & ".docx"
            FileCopy mypath & tepdoc1, mypath & Newname
            .Documents.Open mypath & Newname, Visible = False '打开我们复制的新文件进行更改
            
            '替换各个变量
            For j = 1 To UBound(aar1, 1)
                .Selection.Find.ClearFormatting
                .Selection.Find.Replacement.ClearFormatting
                If j < 16 Then
                    '第i行的数据
                    strn = Sheets(tbldata).Cells(n2, aar1(j, 2))
                Else
                    strn = Sheets(tbldata).Range(aar1(j, 2))
                End If
                With .Selection.Find
                    .Text = "(" & aar1(j, 1) & ")"
                    .Replacement.Text = strn
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchByte = True
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                .Selection.Find.Execute Replace:=wdReplaceAll
            Next j
            .Documents.Save
            
            '第二个“模板2”
            Newname = "报告-" & Sheets(tbldata).Range("D" & n2) & "_" & _
                     Sheets(tbldata).Range("B" & n2) & ".docx"
            FileCopy mypath & tepdoc2, mypath & Newname
            .Documents.Open mypath & Newname, Visible = False
            
            '替换各个变量
            For j = 1 To UBound(aar1, 1)
                .Selection.Find.ClearFormatting
                .Selection.Find.Replacement.ClearFormatting
                If j < 16 Then
                    '第i行的数据
                    strn = Sheets(tbldata).Cells(n2, aar1(j, 2))
                Else
                    strn = Sheets(tbldata).Range(aar1(j, 2))
                End If
                With .Selection.Find
                    .Text = "(" & aar1(j, 1) & ")"
                    .Replacement.Text = strn
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchByte = True
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                .Selection.Find.Execute Replace:=wdReplaceAll
            Next j
           ' .Documents.Save
            .Documents(Newname).Close savechanges:=wdSaveChanges
            
        Next n2
    End With
    Wordapp.Quit
    MsgBox "输出完成,请到" & mypathN & "下查找", vbOKOnly, "提示"

End Sub

到了这里，关于Excel表格数据填充到word模板中的文章就介绍完了。如果您还想了解更多内容，请在右上角搜索TOY模板网以前的文章或继续浏览下面的相关文章，希望大家以后多多支持TOY模板网！