Word宏从多个表创建饼图

时间:2015-11-03 00:45:53

标签: vba ms-word

我有一个单词文档,里面装满了表格。每个表中的第一行是标题,使用修改后的“标题1”样式,还有一个类别字段,使用修改后的标题4样式。

我想编写一个宏,按类别对每个表进行分组,并创建一个显示分布的图表。

这是可能的,如果可以的话,我在哪里可以找到关于如何开始的参考?

我不是VBA程序员,但我对编程语言有一个合理的把握,并希望如果我能找到合适的参考资料并且甚至是可能的话,我可以一起破解。

1 个答案:

答案 0 :(得分:0)

问题有点过于开放,但也许这样的事情可以帮助

'Option Explicit

Sub CreatePie()

    Dim shReport As Worksheet
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim oChart  As Shape
    Dim arrSources As Variant

    ' Remove the report sheet, this is just to remove the testng sheet.
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Report").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' Get all the srouces. Asuming that they all start in Range("A")
    arrSources = GetSources

    Set shReport = Sheets.Add(After:=Sheets(Sheets.Count))
    shReport.Name = "Report"
    Set pc = ActiveWorkbook.PivotCaches.Create(xlConsolidation, arrSources)
    Set pt = pc.CreatePivotTable("Report!R1C1")
    Set oChart = shReport.Shapes.AddChart2(, xlPie)
    oChart.Chart.SetSourceData pt.TableRange1

End Sub

' Function to get all the ranges to be consolitidated.
Function GetSources() As Variant

    Dim sh As Worksheet
    Dim rng As Range
    Dim ret() As Variant
    Dim i As Long

    ReDim ret(Sheets.Count - 1)

    ' Fill all the ranges
    For i = 0 To Sheets.Count - 1
        Set sh = Sheets(i + 1)
        Set rng = sh.Cells(1, 1).CurrentRegion

        ret(i) = Array(sh.Name & "!" & rng.Address(True, True, xlR1C1), "Item" & i + 1)
    Next i

    Var = Array(Array("Sheet1!R1C1:R5C2", "Item1"), Array("Sheet2!R1C1:R5C2", "Item2"), Array("Sheet3!R1C1:R5C2", "Item3"))

    ' Return the value
    GetSources = ret

End Function

Here is my sample file.

希望这会有所帮助:)