Grafiek met reeksen aan- en uitzetten!

[Pieter671]

Ik heb een grafiek, een spreidingsdiagram, met een 5-tal waarden (reeksen). Zie bijgevoegd voorbeeld.

Via de checkbox(en) wil ik de punten in de grafiek als het ware aan- en uitzetten.
Checkbox aangevinkt, betreffend punt wordt zichtbaar.
Checkbox niet aangevinkt, betreffend punt wordt verwijderd.

Het gaat goed wanneer ik in volgorde 1-2-3-4-5 de checkboxen aanzet en deze vervolgens in de volgorde 5-4-3-2-1 weer uitzet.
Als ik 1 verwijder, dan worden de punten 2-3-4-5 vervolgens 1-2-3-4.
ActiveChart.SeriesCollection(5).select bestaand dan niet meer.

Bij iedere ander willekeurig aan en uitzetten gaat het fout, als gevolg van de wijzigingen in de volgorde van de reeksen, SeriesCollection(x), zoals hiervoor omschrevenl.

Zie opzet van de VBA-code bij de checkboxen.

Private Sub CheckBox21_Click()

If CheckBox21.Value = True Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=Blad1!$C$4"
    ActiveChart.SeriesCollection(1).XValues = "=Blad1!$D$4"
    ActiveChart.SeriesCollection(1).Values = "=Blad1!$E$4"
End If

If CheckBox21.Value = False Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection(1).Select
    Selection.Delete
End If
  
End Sub

Private Sub CheckBox22_Click()

If CheckBox22.Value = True Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Name = "=Blad1!$C$5"
    ActiveChart.SeriesCollection(2).XValues = "=Blad1!$D$5"
    ActiveChart.SeriesCollection(2).Values = "=Blad1!$E$5"
End If

If CheckBox22.Value = False Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection(2).Select
    Selection.Delete
End If


End Sub

Private Sub CheckBox23_Click()

If CheckBox23.Value = True Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(3).Name = "=Blad1!$C$6"
    ActiveChart.SeriesCollection(3).XValues = "=Blad1!$D$6"
    ActiveChart.SeriesCollection(3).Values = "=Blad1!$E$6"
End If

If CheckBox23.Value = False Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection(3).Select
    Selection.Delete
End If

End Sub

Private Sub CheckBox24_Click()

If CheckBox24.Value = True Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(4).Name = "=Blad1!$C$7"
    ActiveChart.SeriesCollection(4).XValues = "=Blad1!$D$7"
    ActiveChart.SeriesCollection(4).Values = "=Blad1!$E$7"
End If

If CheckBox24.Value = False Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection(4).Select
    Selection.Delete
End If

End Sub

Private Sub CheckBox25_Click()

If CheckBox25.Value = True Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(5).Name = "=Blad1!$C$8"
    ActiveChart.SeriesCollection(5).XValues = "=Blad1!$D$8"
    ActiveChart.SeriesCollection(5).Values = "=Blad1!$E$8"
End If

If CheckBox25.Value = False Then
    ActiveSheet.ChartObjects("Grafiek 1").Activate
    ActiveChart.SeriesCollection(5).Select
    Selection.Delete
End If

End Sub

Hoe krijg ik de reeksen 1 op 1 gekoppeld aan de checkboxen voor het aan- en uitzetten?
Wie weet hier een oplossing voor?

Bijlage:
Bekijk bijlage Voorbeeld reeksen grafiek.xlsm

 

[Niels28]

Met een draaigrafiek en een eventmacro,
zie tabblad 2 , dubbelklik in kolom D om de nee in ja te veranderen en omgekeerd.


Bekijk bijlage Voorbeeld reeksen grafiek.xlsm

Niels

 

[Pieter671]

@Niels,

Mooie oplossing! Gaat denk ik goed werken als het alleen om deze punten gaat.

In mijn originele grafiek nog meer grafiek-lijnen dit ik niet in een draaitabel kwijt kan.
Ikzelf heb ook een workaround, maar moet dan de grafiek geheel vanuit de basis iedere keer opbouwen,
waarbij deze punten iedere keer variabel zijn. Sorteren van deze laatste punten (reeksen), uitlezen hoeveel reeksen het zijn en dan met een loopje deze punten aan de grafiek toevoegen.

Ben eigenlijk op zoek naar een VBA-oplossing (zonder draaitabel) die sec de punten laat verdwijnen en weer zichtbaar maakt.

Groet,
Pieter

 

[Hans123]

In bijgevoegd bestand een hele simpele oplossing (bestand is overigens niet van mij, maar weet ook niet meer waar ik het vandaan heb)

Werkt door de kolom waar de gegevens in staan te verbergen.

Bekijk bijlage grafiek aan en uitvinken test.xls

 

[Pieter671]

@Hans,

Bedankt, het werk perfect!

Pieter