可點擊複選框的一個功能

我想問這裏的任何人的任何想法。

我在工作表中有很多複選框，我在同一張工作表中鏈接了一個圖表。我想爲每個複選框（單擊時有24個複選框）運行相同的代碼。如果您有任何想法或建議，請告訴我。

這是我的代碼流的想法。我只是有相同的代碼流。

Private Sub CheckBox1_Click() 
On Error Resume Next 
    Sheets("REPORT").Activate 
    ActiveSheets.ChartObjects("STOCK MOVEMENT GRAPH").Activate 
On Error GoTo 0 

If CheckBox1.Value = False Then 
     ActiveChart.SeriesCollection(1).Delete 

    Else 
     ActiveChart.SeriesCollection.Add Source:=Sheets("REPORT").Range("B4:AB4") 
End If 
End Sub 

Private Sub CheckBox2_Click() 
On Error Resume Next 
    Sheets("REPORT").Activate 
    Worksheets("REPORT").ChartObjects("STOCK MOVEMENT GRAPH").Activate 
On Error GoTo 0 

If CheckBox2.Value = False Then 
    ActiveChart.SeriesCollection(2).Delete 

    Else 
     ActiveChart.SeriesCollection.Add Source:=Sheets("REPORT").Range("B5:AB5"), PlotBy:=xlRows 
End If 
End Sub

在此先感謝。問候。

來源

2014-10-30 Nur Adhariah

你要和這種方法您一個問題'對您的系列號碼進行硬編碼：如果刪除系列＃1，那麼＃2將成爲＃1 .... – 2014-10-30 04:06:35

感謝提醒我有關.. ..我沒有意識到它.. – 2014-10-31 04:53:16

您可以退出共同的代碼放到一個獨立的子：

Sub UpdateChart(rowNum As Long, AddingIt As Boolean) 
    Dim cht As Chart, s As Series, rng As Range, f, i 
    Set cht = Sheets("REPORT").ChartObjects("STOCK MOVEMENT GRAPH").Chart 

    'what's the data range? 
    Set rng = Sheets("REPORT").Range("B3").Offset(rowNum, 0).Resize(1, 2) 

    If AddingIt Then 
     'note: not checking if already added.... 
     cht.SeriesCollection.Add Source:=rng 
    Else 
     For i = cht.SeriesCollection.Count To 1 Step -1 
      Set s = cht.SeriesCollection(i) 
      f = s.Formula 
      If InStr(f, rng.Address()) > 0 Then s.Delete 
     Next i 
    End If 
End Sub

那麼你的複選框代碼減少到這一點：

Private Sub CheckBox1_Click() 
    UpdateChart 1, CheckBox1.Value 
End Sub 

Private Sub CheckBox2_Click() 
    UpdateChart 2, CheckBox2.Value 
End Sub 

'etc....

來源

2014-10-30 05:30:16

可點擊複選框的一個功能

回答

相關問題