创build图表时出错（Double Creation）

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

我正在使用下面的代码。

我有代码，在与其他几个调用函数的button后面。

问题是，每当我创build图表时，都会创build它们两次。

我感到困惑是什么原因。

有人可以帮忙弄清楚。

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 

Answer 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 

这将确保它只有一个图表。

Answer 2

您可以使用以下方式在工作表中为每个数据透视表循环：

 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