Office: (Office 2013) Excel Graph mittels Activex Checkbox steuern - VBA Code

Hallo zusammen,

der Inhalt meiner Excel Graphen ändert sich in Abhängigkeit von dem, was in zwei von einander abhängigen Dropdowns (Kombinationsfelder- Form Control) selektiert wird. Hierbei hat mir Beverly schon wahnsinnig geholfen.

1. Nun möchte ich allerdings neben der oben beschriebenen Drobdown Selektion auch zulassen, dass der Anwender mittels ActiveX Checkboxen in einem Graphen bestimmte Datenreihen wieder wegklicken kann. Aktuell sind es >20 Datenreihen je Diagramm, was unübersichtlich sein kann.
Mit welchem Code verknüpfe ich die einzelnen 20 Checkboxen mit den zugehörigen 20 Datenreihen? Die ActiveX Checkboxen befinden sich auf einem Diagramm im "SheetGraph". Die Datenreihen sind im SheetDaten. Checkbox 1 soll sich auf den Bereich "C5:E5" im "SheetDaten" beziehen. Checkbox 2 bezieht sich auf den Bereich "C6:E6" im "SheetDaten" usw.

2. Die Namen/Aufschriften meiner Checkboxen ändern sich mit dem unten stehenden Code, was einwandfrei funktioniert, solange ich den Code manuell durchlaufen lasse. Die Aufschriften ändern sich in Abhängigkeit der Range "B5:B25" (s. Code). Der Zelleninhalt der Range wiederum ändert sich in Abhängigkeit der Auswahl, die über das Dropdown gemacht wurde, sofern ich den Code durchlaufen lasse. Ich möchte jetzt allerdings, dass sich bei Änderung der Dropdownauswahl automatisch und sofort die Aufschriften der Checkboxen ändern. Die Range "B5:B25" ist variabel (die Range kann auch von "B5:B30" gehen), entsprechend würden mal 20 und mal 25 checkboxen benötigt werden.

Private Sub CheckBox1_Change()
Dim oobElement As OLEObject
Dim arrAufschrift
Dim intZaehler As Integer
intZaehler = 1
arrAufschrift = Application.Transpose(Worksheets("SheetDaten").Range("B5:B20"))
For Each oobElement In Worksheets("SheetGraph").OLEObjects
oobElement.Object.Caption = arrAufschrift(intZaehler)
intZaehler = intZaehler + 1
Next oobElement
End Sub

Wer kann mir hier helfen?

Vielen Dank
Nelspruit

 

Hi,

lade bitte eine Beispielmappe mit dem genauen Tabellen- und Diagrammaufbau hoch. Vielleicht kann man es auch ohne VBA lösen.

Bis später,
Karin

 

Hi Karin,

danke für deine Antwort! Anbei eine Beispieldatei. Der Umfang hat sich in dieser Beispieldatei etwas verändert, da ich die Originaldatei nicht zur Verfügung stellen kann. Statt 20 oder 25 Checkboxen sind es nun 4 oder 5. Der Bereich hat sich auch etwas verkleinert :-)


Vielen Dank :-)
Gruß
Nelspruit

 

Hi,

weise den Kontrollkästchen jeweils eine LinkedCell zu - z.B. in Tabelle "SheetDaten" ab F5 jeweils entsprechend der darzustellenden Datenreihe und schreibe deine Formel in A5 mit Bezug auf die Zelle F5: =WENN(F5=WAHR;VERGLEICH(B5;'Daten für Kombobox'!$B$10:$B$24;0);#NV) - Formel nach unten ziehen. Dann wird im Diagramm nur diejenige Datenreihe angezeigt, deren Kontrollkästchen aktiviert und damit den Wert WAHR in die zugewiesene Zelle schreibt.

Bis später,
Karin

 

Hi Karin,

vielen Dank, das funktioniert hervorragend.

Wie bekommen ich es nun aber hin, dass automatisch, sobald sich die Dropdownauswahl ändert (bsp. von Mercedes auf BMW) die Aufschriften der Checkboxen von CLA, C-Klasse, A-Klasse zu 1er, 240, 5er 7er im Graphen ändern?

Vielen lieben Dank nachmol!

Nelspruit

 

Hi,

benutze das Activte-Ereignis des Tabellenblattes:

Code:

Private Sub Worksheet_Activate()
   Dim oobElement As OLEObject
   Dim arrAufschrift
   Dim intZaehler As Integer
   intZaehler = 1
   arrAufschrift = Application.Transpose(Worksheets("SheetDaten").Range("B5:B8"))
   For Each oobElement In Worksheets("SheetGraph").OLEObjects
      If Not IsError(Worksheets("SheetDaten").Cells(intZaehler + 4, 3)) Then
        oobElement.Visible = True
        oobElement.Object.Caption = arrAufschrift(intZaehler)
      Else
        oobElement.Visible = False
      End If
   intZaehler = intZaehler + 1
   Next oobElement
End Sub

Bis später,
Karin

 

Hi Karin,

vielen Dank, auch für die Anpassung des Codes! Läuft prima!

Viele Grüße
Nelspruit

 

Hi Karin,

angenommen, ich möchte zwei Graphen im Sheetgraph (Graph Mercedes und Graph BMW) abbilden und je Graph mittels Checkboxen die Datenreihen "CLA, C-Klasse, A-Klasse" und "1er, 240, 5er 7er" aus-oder abwählen. Nach wie vor sollen sich die Checkboxen in Abhängigkeit vom Dropdown ändern. Der zweite Bereich neben Range("B5:B20") ist Range ("I5:I20"). Wie bringe ich die zweite Range unter?
Ich habe es mit untenstehender Anpassung deines Codes probiert, bekomme allerdings eine Fehlermeldung (Run-time error 1004: Application-defined or object-defined error).

Dankeschön :-)
Gruß
Nelspruit

Private Sub Worksheet_Activate()
Dim oobElement As OLEObject
Dim arrAufschrift
Dim intZaehler As Integer
intZaehler = 1
arrAufschrift = Application.Transpose(Worksheets("Dropdown_data").Range("B5:B20"), Range("I5:I16"))
For Each oobElement In Worksheets("Region").OLEObjects
If Not IsError(Worksheets("Dropdown_data").Cells(intZaehler + 4, 3)) Then
oobElement.Visible = True
oobElement.Object.Caption = arrAufschrift(intZaehler)
Else
oobElement.Visible = False
End If
intZaehler = intZaehler + 1
Next oobElement
End Sub

 

Hi,

was meinst du das mit 2 Graphen darstellen und was hat es mit dem Bereich I5:I8 auf sich?

Bis später,
Karin

 

Hi Karin,

ich habe eine Mappe angehangen und im "SheetGraph" den zweiten Graphen zugefügt sowie die Checkboxen auch für den 2. Graphen verknüpft (LinkedCell im SheetDaten "O5:O8").

Wie kann ich nun für den 2. Graphen den VBA Code so anpassen, dass zusätzlich zum ersten Bereich auch der zweite Bereich (nun K5:K10) für die Checkboxen des 2. Graphen berücksichtigt werden.

Ich hoffe, ich habe mich nun besser erklärt :-)

Viele Grüße
Nelspruit

 

Hi,

ein Graph ist eine Datenreihe in einem Diagramm. Wenn ich das nun richtig sehe, sind es nicht 2 Graphen (2 Datenreihen) im selben Diagramm sondern 2 Diagramme mit je 1 Graphen (1 Datenreihe).

Das kann man nicht 1:1 mit dem bisherigen Code lösen, da muss unterschieden werden, um welche Spalte es sich bei der LinkedCell der Kombinationsfelder handelt. In dem Fall macht man das am besten, indem man sich auf die Spalte und die Zeile der LinkedCell bezieht und nicht die Daten in ein Array schreibt.
Folgenden Code ins Codemodul der Tabelle "SheetGraph"!!!:

Code:

Private Sub Worksheet_Activate()
   Dim oobElement As OLEObject
   Dim strAdresse As String
   Dim intSpalte As Integer
   Dim lngZeile As Long
   intZaehler = 1
   For Each oobElement In Worksheets("SheetGraph").OLEObjects
      strAdresse = Split(oobElement.LinkedCell, "!")(1)
      lngZeile = Range(strAdresse).Row
      Select Case Range(strAdresse).Column
        Case 6
            intSpalte = 2
        Case 15
            intSpalte = 11
      End Select
      If Not IsError(Worksheets("SheetDaten").Cells(lngZeile, intSpalte - 1)) Then
        oobElement.Visible = True
        oobElement.Object.Caption = Worksheets("SheetDaten").Cells(lngZeile, intSpalte)
      Else
        oobElement.Visible = False
      End If
   Next oobElement
End Sub

Bis später,
Karin

 

Hi Karin,

entschuldige die späte Rückmeldung! Ich war eine Woche unterwegs und hatte eine extremst schlechte Internetverbindung
Der Code funktioniert hervorragend, vielen Dank dafür. Ich habe nur leider noch ein Problem.
Die ActiveX Control Boxen verschwinden, wenn ich folgendes mache:
Im ersten Dropdown wähle ich BMW und im zweiten Dropdown Mercedes. In den beiden jeweiligen Graphen sind die Checkboxen sichtbar und können selektiert werden. Wenn ich nun im Graphen Mercedes eine Checkbox deselektiere und hinterher die Dropdownauswahl des 2. Dropdowns auf BMW oder Audi setze, fehlt die Checkbox bzw, ist sie nicht mehr sichtbar.
Über manuelles Klicken in den Propperties der ActiveX Boxen kann ich dieses Problem wieder beheben und die Checkbox sichtbar machen (setzen der ActiveX Boxen von "Visible:False" auf "Visible: True"), allerdings möchte ich diesen manuellen Schritt vermeiden. Gibt es daher noch einen anderen Weg über den VBA Code?

Gruß und danke
Nelspruit

 

Hi,

ergänze vor der For-Schleife noch diese beiden Zeilen:

Code:

    Worksheets("SheetDaten").Range("F5:F11") = True
    Worksheets("SheetDaten").Range("O5:O11") = True

Bis später,
Karin

 

Hi Karin,

vielen Dank:-)

Gruß
Nelspruit