利用Word生成报告

前段时间，有人问我能不能自动生成Word报告。需求是这样的，简述一下。要求根据提供的基础信息来生成所要的word报告。

0.思路

---

之前想直接用vbscript整篇生成的，但是整个报告的篇幅还是很长的，所以手写还是很费时很费力的。所以想转换思路，直接在Word中查找替换来实现，这样省去了排版的和输出文字等很多重复性的工作。但是这样的话有几个之前没弄过的：

1. 图片和表格保持原样式
2. 将添加的按钮控件删除
3. 定位和文件格式
4. 生成的文档不能有宏
5. 页眉的修改

1.实现

---

其实掌握了其中的诀窍之后，也不是很难的。首先查找替换功能网上都有现成的例子，可以参考，下面是代码：

Sub findAndReplace(find, replace)
    Dim oRng As Range
    Set oRng = Word.ActiveDocument.Content
    With oRng.find
        .ClearFormatting
        With .Replacement
            .ClearFormatting
        End With
        .Execute FindText:=find, ReplaceWith:=replace, replace:=wdReplaceAll
    End With
End Sub

接着是查找替换表格，这边略有不同，是利用了复制粘贴的功能，不得不说这个还是很实用的。微软的文档

' 查找到标签时会选中，然后将表格选中并粘贴进来就行
Sub copyTable(ObjWD, table, tag)
    table.Select
    ObjWD.selection.Copy
    With Word.selection.find
     .Forward = True
     .ClearFormatting
     .MatchWholeWord = True
     .MatchCase = False
     .Wrap = wdFindContinue
     .Execute FindText:=tag
    End With
    ' 这边需要注意，粘贴时需要保持原格式。参数的枚举值可以去官网查
    Word.selection.PasteAndFormat 16
End Sub

图片的处理和表格大同小异，主要是图片怎么取到的问题。这边看了文档没法确定那个图片是哪个，所以最后还是按顺序来操作的

Dim picArray, num
num = 0
picArray = Array("pic0", "pic1", "pic2", "pic3", "pic4")
For Each shp In ObjDOC.InlineShapes
  If shp.Type = 3 Then ' 3 代表是图片
    copyPicture ObjWD, shp, picArray(num) 
    num = num + 1 
  End If 
Next

之前提到的删除控件也和上面类似，只是类型不同，具体可参看官方文档。

保存不带宏的是通过新建一个新的文档，把处理好的结果全部拷贝过来，然后粘贴到新的文档中，注意⚠️要保存原格式。

替换使用唯一标签🏷️标记出来，找到了直接替换就行

页眉的也记录下

Sub EditHeaders(text)
Dim i As Long
For i = 1 To ActiveDocument.Sections.Count
    With ActiveDocument.Sections(i)
        .Headers(1).Range.text = text
    End With
Next
End Sub

2.结语

---

这个还有很多值得优化的地方，比如现在表格是和替换逻辑是写死，后续可以提供相关的信息来让用户选择。还有很多细节的东西可以推敲。今天就写到这吧，完整的代码就不贴了，其他的也没啥好贴的。如果想要的可以留言我。