VBA学习(29)：根据EXCEL数据自动生成WORD报表

需求描述

这个是知乎上一个朋友的付费提问内容，因为需求很简单，我把程序直接写好了，在这里把代码分享给大家。

我们有一个Excel报表文件，格式如下：

我们要把里面的数据，一键导入到以下的Word文档：

 

这个文档看着也很简单，有一些特别需要注意的地方，我这里说一下

• 表格中的天气部分，需要根据Excel表格内部的信息判断，如果是【晴天】，则Word表格中的晴天那一列要打两个√。

 思路

• 诸如【日期】、【巡查项目点】等这些信息，代码采用替换的方式解决。

• Word文档作为一个模板存在，后期会单独另存一份新的文档。

• Word表格内部直接按位置写入数据。

具体代码

Sub 导出word()
    Set doc = CreateObject("word.application")                 '创建Word对象
    Set wd = doc.Documents.Open(ThisWorkbook.Path & "\日报模板 .docx")
    doc.Visible = True
    '//判断天气
    Set tbl = wd.tables(1)
    Select Case Trim(Range("b3").Value)
        Case "晴"
            tbl.Cell(4, 2).Range.Text = "√"
            tbl.Cell(5, 2).Range.Text = "√"
        Case "阴"
            tbl.Cell(4, 3).Range.Text = "√"
            tbl.Cell(5, 3).Range.Text = "√"
        Case "雨"
            tbl.Cell(4, 4).Range.Text = "√"
            tbl.Cell(5, 4).Range.Text = "√"
        Case "雷暴"
            tbl.Cell(4, 5).Range.Text = "√"
            tbl.Cell(5, 5).Range.Text = "√"
        Case "大风"
            tbl.Cell(4, 6).Range.Text = "√"
            tbl.Cell(5, 6).Range.Text = "√"
        Case "台风"
            tbl.Cell(4, 7).Range.Text = "√"
            tbl.Cell(5, 7).Range.Text = "√"
    End Select
    '//写word表格其余信息
    tbl.Cell(4, 8).Range.Text = Range("c3").Value              '平均气温
    tbl.Cell(4, 9).Range.Text = Range("d3").Value              '相对湿度
    tbl.Cell(3, 10).Range.Text = Range("e3").Value             '平均气温
    '//写段落中的信息
    replaceStr doc, Range("a3").Text, "{$日期}"
    replaceStr doc, Range("f3").Value, "{$巡查项目点}"
    replaceStr doc, Range("g3").Value, "{$养护团队次数}"
    replaceStr doc, Range("h3").Value, "{$养护团队项目点}"
    replaceStr doc, Range("i3").Value, "{$病害治理包组次数}"
    replaceStr doc, Range("j3").Value, "{$病害治理项目点}"
    '//另存生成的文档，并且关闭模板文档
    wd.SaveAs ThisWorkbook.Path & "\" & Range("a3").Text & "日报.docx"
    wd.Close False
    doc.Quit
    MsgBox "完成！"
End Sub
Function replaceStr(doc, reStr, findStr)
    doc.Selection.HomeKey 6
    With doc.Selection.Find
        .Text = findStr                                        '要查找的内容
        .Forward = True
        .Replacement.Text = reStr                              '替换的结果
        .Wrap = 1
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .Execute Replace:=1
    End With
End Function

 技术交流，软件开发，欢迎微信沟通：