VBA用户定义图表功能创建多个系列

时间:2014-07-21 13:08:03

标签: excel vba excel-vba charts

我有一个VBA电子表格,允许用户添加其他电子表格的内容,格式化,计算总计和添加饼图。它基本上工作得很好,除非有一个月的标签,当我们想要一个饼中的所有数据点时,每个数据点创建一个系列。

这是创建饼图的功能。

Sub AddChart(CurrentWorkSheet As Worksheet)
Dim FirstRow As Integer
Dim LastRow As Integer
Dim FirstColumn As String
Dim LastColumn As String
Dim DataRange As Range
Dim i As Integer

FirstRow = RowCount(CurrentWorkSheet) + 2
LastRow = FirstRow + 4
Set DataRange = CurrentWorkSheet.Range("I" & FirstRow & ":I" & LastRow)

Dim MyChart As Chart
Set MyChart = CurrentWorkSheet.Shapes.AddChart(xlPie).Chart

MyChart.SetSourceData Source:=DataRange
MyChart.SeriesCollection(1).HasDataLabels = True

For i = 1 To MyChart.SeriesCollection(1).Points.Count
    If i = 1 Then
        MyChart.SeriesCollection(1).Points(i).Interior.Color = RGB(0, 176, 80)
    ElseIf i = 2 Then
        MyChart.SeriesCollection(1).Points(i).Interior.Color = RGB(255, 0, 0)
    ElseIf i = 3 Then
        MyChart.SeriesCollection(1).Points(i).Interior.Color = RGB(112, 48, 160)
    ElseIf i = 4 Then
        MyChart.SeriesCollection(1).Points(i).Interior.Color = RGB(0, 0, 0)
        MyChart.SeriesCollection(1).Points(i).DataLabel.Font.Color = RGB(255, 255, 255)
    ElseIf i = 5 Then
        MyChart.SeriesCollection(1).Points(i).Interior.Color = RGB(0, 112, 192)
    Else
    End If
Next

MyChart.SeriesCollection(1).XValues = CurrentWorkSheet.Range("H" & CStr(FirstRow) & ":H" & CStr(LastRow))
End Sub

在此工作簿中,每个月都有一个YTD工作表和一个工作表。当它到达四月时,馅饼有一种颜色。所有其他月份都很好。

数据集如下:

ATTACHMENT            962.31
DAMAGE              3,279.94
MODIFICATIONS         451.00
REPAIRS             5,239.78
TIRES               1,979.04

数据范围是第51-55行。

=SERIES(,'Apr 2014'!$H$51:$H$55,'Apr 2014'!$I$51,1)

当我在Excel中查看该系列时,列出了5个,第一个是ATTACHMENT,最后4个是1。每个月都使用相同的功能以及YTD标签,除了4月份它们都可以。

任何想法可能导致它?

1 个答案:

答案 0 :(得分:0)

我想我明白了。我改变了以下

Set DataRange = CurrentWorkSheet.Range("I" & FirstRow & ":I" & LastRow)

Set DataRange = CurrentWorkSheet.Range("I" & CStr(FirstRow) & ":I" & CStr(LastRow))

似乎现在正在工作。不确定为什么它在其他选项卡上运行正常....