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

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

引用

CSDN

1.

https://blog.csdn.net/taller_2000/article/details/139106326

在Word中创建图表时，如果表格数据包含合并单元格，直接插入图表可能会遇到困难。本文将通过VBA代码示例，详细介绍如何将Word表格数据转换为适合创建图表的格式，并最终生成柱状图。

实例需求

Word的表格如下所示，标题行有合并单元格。

现在需要根据上述表格数据，在Word中创建如下柱图。如果数据在Excel之中，那么创建这个图并不复杂，但是Word中就没用那么简单了，虽然Word中可以插入图表，但是其数据源仍然是来自于Excel。

示例代码

Sub CreateWordChart3()
    Dim oChart As Chart, oTable As Table
    Dim oSheet As Object ' Excel.Worksheet
    Const START_CELL = "AA1"
    Application.ScreenUpdating = False
    Set oTable = ActiveDocument.Tables(1)  ' modify as needed
    Set oChart = ActiveDocument.Shapes.AddChart.Chart
    Set oSheet = oChart.ChartData.Workbook.Worksheets(1)
    oTable.Range.Copy
    oSheet.Range(START_CELL).Select
    oSheet.Paste
    Call Create2DTable(oSheet, oSheet.Range(START_CELL))
    oChart.ChartData.Workbook.Close
    Application.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, vKey
    Dim rCell As Object 
    Dim rC As Object 
    Dim i As Long, j As Long
    Set oDicCat = CreateObject("scripting.dictionary")
    Set oDicSt = CreateObject("scripting.dictionary")
    With startCell.CurrentRegion
        For Each rCell In .Rows(2).Cells
            If Len(rCell) > 0 Then
                oDicCat(rCell.Value) = ""
            End If
        Next
        For Each rCell In .Rows(1).Cells
            sKey = rCell
            If Len(sKey) > 0 Then
                If Not oDicSt.Exists(sKey) Then
                    Set oDicSt(sKey) = CreateObject("scripting.dictionary")
                    For Each vKey In oDicCat
                        oDicSt(sKey)(vKey) = ""
                    Next
                End If
                For Each rC In rCell.Offset(1).Resize(1, rCell.MergeArea.Count)
                    oDicSt(sKey)(rC.Value) = rC.Offset(1).Value
                Next
            End If
        Next
    End With
    Dim xlTab As Object 
    Set xlTab = tmpSheet.ListObjects("Table1")
    xlTab.DataBodyRange.Delete
    Dim RowCnt As Long, ColCnt As Long
    RowCnt = oDicSt.Count
    ColCnt = oDicCat.Count
    xlTab.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
        For j = 1 To RowCnt
            sKey = oDicSt.keys()(j - 1)
            .Cells(j + 1, 1) = sKey
            For i = 1 To ColCnt
                .Cells(j + 1, i + 1) = oDicSt(sKey)(.Cells(1, i + 1).Text)
            Next
        Next
    End With
    startCell.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行代码清空辅助单元格区域。

运行示例代码，最终效果如下图所示。