關於VBA編輯word自動生成報告
這適合於圖比較多，表比較多，並且報告格式單一，但每天需要大量出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 FunctionFunction 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