创建图表时出错(双重创建)

时间:2017-08-25 11:35:56

标签: excel vba excel-vba

我正在尝试在我的工作表Monthprepare上创建一个图表。

我正在使用以下代码。

我有代码,在按钮后面有几个其他调用函数。

问题是,每当我创建图表时,它都会创建两次。

我感到困惑的原因是什么。

有人可以帮忙解决这个问题。

Sub chartmonthprep()
Dim cht As Chart
Dim stable As PivotTable
Dim pt, sh
If ActiveSheet.PivotTables.count = 0 Then Exit Sub
Set stable = ActiveSheet.PivotTables(2)
Set pt = stable.TableRange1
Set sh = ActiveSheet.ChartObjects.Add(Left:=250, _
Width:=400, Top:=20, Height:=250)
sh.Select
Set cht = ActiveChart
With cht
.SetSourceData pt
.ChartType = xlColumnStacked
End With
cht.FullSeriesCollection(1).Name = "Average of Red"
cht.SeriesCollection(1).HasDataLabels = True
cht.SeriesCollection(2).HasDataLabels = True
cht.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(0, 255, 0)
cht.SeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
cht.HasTitle = True
cht.ChartTitle.Text = " Result"
End Sub

2 个答案:

答案 0 :(得分:1)

试试这样:

Sub chartmonthprep()
    If ActiveSheet.ChartObjects.Count > 1 Then Exit Sub

    'the rest of your code here --v
    Dim cht As Chart
    Dim stable As PivotTable


End Sub

它将确保它只是一张图表。

答案 1 :(得分:0)

您可以使用以下内容循环播放表格中的每个数据透视表:

Sub PivotTable()
    Dim sh As Worksheet
    Dim pvt As PivotTable

    Set sh = ThisWorkbook.Sheets("Sheet1")

    For Each pvt In sh.PivotTables
        MsgBox pvt.Name
        'do something
    Next pvt
End Sub