實例需求：Word的表格如下所示，標題行有合并單元格。
現在需要根據上述表格數據，在Word中創建如下柱圖。如果數據在Excel之中，那么創建這個圖并不復雜，但是Word中就沒用那么簡單了，雖然Word中可以插入圖表，但是其數據源仍然是來自于Excel。
示例代碼如下。
Sub CreateWordChart3()Dim oChart As Chart, oTable As TableDim oSheet As Object ' Excel.WorksheetConst START_CELL = "AA1"Application.ScreenUpdating = FalseSet oTable = ActiveDocument.Tables(1) ' modify as neededSet oChart = ActiveDocument.Shapes.AddChart.ChartSet oSheet = oChart.ChartData.Workbook.Worksheets(1)oTable.Range.CopyoSheet.Range(START_CELL).SelectoSheet.PasteCall Create2DTable(oSheet, oSheet.Range(START_CELL))oChart.ChartData.Workbook.CloseApplication.ScreenUpdating = True
End Sub
【代碼解析】
第4行代碼指定輔助數據區域的起始單元格（下文中簡稱為錨點單元格）。
第5行代碼禁止屏幕更新。
第6行代碼獲取活動文檔中的第一個表格對象。
第7行代碼在文檔中添加一個Chart對象。
第8行代碼獲取Chart對象的Worksheet對象（即圖表數據源所在工作表）。
第9行代碼拷貝表格區域。
第10行代碼選中錨點單元格。
第11行代碼粘貼數據，實現將Word表格數據導入到Excel工作表中。
第12行代碼調用Create2DTable過程轉換數據。
第13行代碼關閉Chart對象的源數據工作簿。
第14行代碼恢復屏幕更新。
Sub Create2DTable(ByRef tmpSheet As Object, startCell As Object)Dim oDicCat As Object, oDicSt As Object, sKey, vKeyDim rCell As Object Dim rC As Object Dim i As Long, j As LongSet oDicCat = CreateObject("scripting.dictionary")Set oDicSt = CreateObject("scripting.dictionary")With startCell.CurrentRegion' get the unique CatX listFor Each rCell In .Rows(2).CellsIf Len(rCell) > 0 ThenoDicCat(rCell.Value) = ""End IfNext' loop through tableFor Each rCell In .Rows(1).CellssKey = rCellIf Len(sKey) > 0 ThenIf Not oDicSt.Exists(sKey) ThenSet oDicSt(sKey) = CreateObject("scripting.dictionary")For Each vKey In oDicCatoDicSt(sKey)(vKey) = ""NextEnd If' store values with nested DictFor Each rC In rCell.Offset(1).Resize(1, rCell.MergeArea.Count)oDicSt(sKey)(rC.Value) = rC.Offset(1).ValueNextEnd IfNextEnd WithDim xlTab As Object ' Excel.ListObjectSet xlTab = tmpSheet.ListObjects("Table1")xlTab.DataBodyRange.Delete' get the size of output tableDim RowCnt As Long, ColCnt As LongRowCnt = oDicSt.Count: ColCnt = oDicCat.CountxlTab.Resize tmpSheet.Range("A1").Resize(RowCnt + 1, ColCnt + 1)With xlTab.Range.Cells(1, 1) = "REQ"For i = 1 To ColCnt.Cells(1, i + 1) = oDicCat.keys()(i - 1)Next' populate outputFor j = 1 To RowCntsKey = oDicSt.keys()(j - 1).Cells(j + 1, 1) = sKeyFor i = 1 To ColCnt.Cells(j + 1, i + 1) = oDicSt(sKey)(.Cells(1, i + 1).Text)NextNextEnd WithstartCell.CurrentRegion.Clear
End Sub
【代碼解析】
第6~7行代碼創建兩個字典對象。
第8行代碼獲取輔助表格的單元格區域。
第9~13行代碼循環遍歷表格中第二行單元格，將排重的“類別”列表保存在字典對象oDicCat中。
第10行代碼判斷類別不為空，并且不等于行標題。
第14~27行代碼循環遍歷第一行單元格。
第15行代碼獲取單元格內容。
第16行代碼判斷單元格是否為空，即“評估狀態”。
第17行代碼判斷“評估狀態”是否存在于字典對象oDicRes中。
第18行代碼以sKey為鍵，創建嵌套字典對象。
第19~20行代碼為新建的字典對象增加“類別”，這樣可以將數據表轉換為規范的2D表格，即每個“評估狀態”都包含3個類別，這樣數據便于創建圖表。
第23~25行代碼讀取第3行單元格數據，保存到對應的嵌套字典對象之中。
第30行代碼獲取工作表中的表格對象（ListObject）。
第31行代碼清空表格數據區域。
第33~34行代碼獲取獲取類別和“評估狀態”的個數，這決定了數據表格的維度（行數和列數）。
第35行代碼重設表格區域。
第37行代碼寫入數據。
第38~40行代碼循環讀取oDicCat中內容，寫入表格標題行（類別）。
第41~47行代碼寫入表格數據。
第42~43行代碼寫入第一列“評估狀態”。
第44~46行代碼寫入評估統計數據。
第49行代碼清空輔助單元格區域。
運行示例代碼，最終效果如下圖所示。
)
