关于VBA编辑word自动生成报告

关于VBA编辑word自动生成报告

-
-
-

工具

如图片所示,虽然版本可以不同，但库的类别相差不大

难点

• 输入划分

  一般word文档中的输入是 图和表，如果将输入按照对象类型来划分不同的文件夹，通过划分文件类型，降低了对象处理难度.由此需要1个函数来读取文件路径并存储。

• 输入处理

  图和表都是需要插入到word文档的，可以不通过判断文件类型来处理。使用bookmark标记对象处在的位置，可以不考率对象类型，根据之前的文件夹划分对象，即可插入正确的对象类型。这里有个难点就是，如何根据word文档模板中的表名和图片名，自动的生成bookmark.（其实只要格式是固定的，自己做1个模板，定义不同表名与图片名的bookmark名字，也可以。这样就限定了使用。只要格式不一样，就需要手动创建word模板）

  举个例子说明，有Table 1: Information_1 和 Table 2: Information_2
  需要在这2行的位置之上插入1个bookmark。手动的做法是，鼠标点击该行上一行的起始位置， 点击菜单栏的 插入->书签->命名并添加书签名

• 格式调整问题

  对于表格的格式调整，很麻烦。尤其是存在合并单元格的表格。当通过vba，从excel插入表格到对应的bookmark。表格的格式要与word页面想匹配，是个很大的问题。

  图片的格式调整就很容易，只需使输入图片的大小一致即可。 （一般报告的图片输入，都是大小一致的）

功能块

• openfilemethod() 用于打开文件夹的并计数文件个数

以下2个方程可以实现openfilemethod() 方法（本人不知道VBA中怎么返回多个不同类型的参数，所以分了2个function）, 30限定了插入对象个数，其实完全够了，毕竟1个word文档有30幅图很多了。Application.FileDialog(msoFileDialogOpen)是word vba开发手册中实现的方法。

Function openfileway(bol As Boolean) As Variant
Dim lngCount As Long
Dim pathstr(1 To 30) As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = bol’可以选择多个文件
.Show
For lngCount = 1 To .SelectedItems.Count
pathstr(lngCount) = .SelectedItems(lngCount)
Next lngCount
End With
openfileway = pathstr
End Function

Function openfilecount(ParamArray arr()) As Integer
Dim i As Integer
For i = 1 To 30
If arr(0)(i) Like “” Then
Exit For
End If
Next
openfilecount = i - 1
End Function

• addpicture()用于插入图片

Sub addpicture(i As Integer, s As Variant, dcwd As Word.document, ParamArray pathstr())
Dim j As Integer
For j = 1 To i
If InStr(pathstr(0)(j), s) > 0 Then
dcwd.InlineShapes.addpicture _
Filename:=pathstr(0)(j), _
LinkToFile:=False, SaveWithDocument:=True, _
Range:=dcwd.bookmarks(s).Range
End If
Next
End Sub

• picturesize()可以调整图片大小

Sub picturesize(dcwd As Word.document)
Dim j As Integer
For j = 1 To dcwd.InlineShapes.Count
picheight = dcwd.InlineShapes(j).Height
picwidth = dcwd.InlineShapes(j).Width
dcwd.InlineShapes(j).Height = picheight * 0.75 ‘设置高度为0.75倍
dcwd.InlineShapes(j).Width = picwidth * 0.75 ‘设置宽度为0.75倍
dcwd.InlineShapes(j).Borders.OutsideLineStyle = wdLineStyleSingle
Next j
End Sub

• exceltablepaste()用于插入table表

Sub excelpaste(i As Integer, s As Variant, dcwd As Word.document, sheetname As String, srange As String, bookmark As String, ParamArray pathstr())
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range

'Initialize the Excel objects.
Set wbBook = GetObject(workpath(workcount))
Set wsSheet = wbBook.Worksheets(sheetname)
Set rnReport = wsSheet.Range(srange)
 Set wdbmRange = dcwd.bookmarks(bookmark).Range
'Turn off screen updating.
Application.ScreenUpdating = False
rnReport.Copy

With wdbmRange
    .Select
    .PasteSpecial link:=False, _
                  DataType:=wdPasteRTF, _
                  Placement:=wdFloatOverText, _
                  DisplayAsIcon:=False
End With


Set wdbmRange = Nothing

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

wbBook.Close '关闭打开的workbook，不然会有excel的进
End Sub