使用Word表格数据快速创建图表

实例需求：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行代码清空辅助单元格区域。