CheckBoxen zusammenfassen

Question

Hallo Zusammen,

ich habe eine Tabelle mit etwa 30 Zeilen (A4 bis O34) mit jeweils 1 CheckBox je Zeile, die die Schriftfarbe verändern soll. Kann mir jemand helfen und mir zeigen, wie ich den Code verändern muss, damit ich nicht 30 mal diesen Code benötige, sondern in einem zusammengefasst wird?


Private Sub CheckBox1_Change()
If ActiveSheet.CheckBox1 = True Then
ActiveSheet.Range("A4:o4").Font.ColorIndex = 15
Else
ActiveSheet.Range("A4:o4").Font.ColorIndex = 1
End If
End Sub


Vielen Danke schon mal für eure Hilfe. - Die Tabelle ist mit Excel 2010 erstellt.

VG
Florian

Answer 1

Hallo Florian,

ich nehme mal an, dass du bei Aktivierung einer Checkbox in der jeweiligen Zeile von Spalte A bis O die Schriftfarbe ändern willst.

Schreibe in den Code der Checkboxen jeweils:

Private Sub CheckBox1_Click()

cbnr = 1
Call faerben

End Sub

Dabei wird der Variable cbnr die jeweilige Checkbox-Nummer zugewiesen (ich gehe davon aus, dass die Checkboxen die Nummern 1 bis 31 haben). Der Code für Checkbox 2 muss dann also heißen:

Private Sub CheckBox2_Click()

cbnr = 2
Call faerben

End Sub

usw.
Schreibe in ein allgemeines Modul den folgenden Code:

Public cbnr As Long

Sub faerben()
If Sheets("Tabelle1").OLEObjects("CheckBox" & cbnr).Object.Value = True Then
ActiveSheet.Range(Cells(cbnr + 3, 1), Cells(cbnr + 3, 15)).Font.ColorIndex = 15
Else
ActiveSheet.Range(Cells(cbnr + 3, 1), Cells(cbnr + 3, 15)).Font.ColorIndex = 1
End If

End Sub

Den Namen der Tabelle (hier "Tabelle 1") musst du entsprechd anpassen.

Gruß

M.O.

Answer 2

Hallo M.O.,

vielen Dank für deine Hilfe.

Nur kommt jetzt immer folgende Meldung:

Fehler beim Kompilieren - Mehrdeutiger Name: ...


Auszug:

Private Sub CheckBox18_Click()
cbnr = 18
Call faerben
End Sub

Private Sub CheckBox19_Click()
cbnr = 19
Call faerben
End Sub

Private Sub CheckBox20_Click()
cbnr = 20
Call faerben
End Sub

Gruß
Florian

Was bewirkt OLEObjects?

Danke

Gruß
Florian

Answer 3

Hallo Florian,

hast du ggf. schon ein Makro mit dem Namen faerben ? Dann benenne ein Makro um.

Mit

OLEObjects("CheckBox" & cbnr)

wird die jeweilige Checkbox - in Verbindung mit der Variablen cbnr - angesprochen; hier die Prüfung ob die Checkbox aktiviert ist oder nicht.

Gruß

M.O.

Answer 4

Hallo M.O.

danke das wars. Hatte versehentlich das Makro doppelt drin.

Mit diesem Code wandern die CheckBoxen allerdings nicht mit, sondern sind an ihre feste Zeile gebunden. Gibt es die Möglichkeit, dass die Checkboxen z.B. beim sortieren mitwandern? (Vor Sortierung ist z.B. Checkbox3 in Zeile 3, nach der Sortierung ist Checkbox3 in Zeile 5 und markiert somit die Zeile 5)

VG
Florian

Answer 5

Hallo Florian,

zum Sortieren von Checkboxen schau dir mal diesen Link an.

Allerdings muss dann auch dein Färben-Makro angepasst werden, da dann die Zeilenzuordnung unabhängig von der Nummer der Checkbox ist (wenn Checkbox 3 in Zeile 5 wäre, würde nach dem alten Makro die Schriftfarbe in Zeile 6 geändert).

Hier der angepasste Code für die Änderung der Schriftfarbe:

Public cbnr As Long

Sub faerben_neu()
Dim zeile As Long

zeile = Sheets("Tabelle1").OLEObjects("CheckBox" & cbnr).TopLeftCell.Row

If Sheets("Tabelle1").OLEObjects("CheckBox" & cbnr).Object.Value = True Then
ActiveSheet.Range(Cells(zeile, 1), Cells(zeile, 15)).Font.ColorIndex = 15
Else
ActiveSheet.Range(Cells(zeile, 1), Cells(zeile, 15)).Font.ColorIndex = 1
End If

End Sub

Den Namen der Tabelle (hier "Tabelle 1") musst du natürlich wieder anpassen.

Gruß

M.O.

Answer 6

Hallo Florian,

was ich vergessen habe: Es wird nur die richtige Zeile ausgegeben, wenn deine Checkboxen mit der linken oberen Ecke (= TopLeftCell) in der Zeile stehen, in der die Schriftfarbe geändert werden soll.
Das ist auch wichtig für das Sortieren (siehe Link).

Gruß

M.O.

Answer 7

Hallo M.O.,

das ist jetzt wirklich genau das, was ich wollte.

Vielen Dank.

Nur noch eine hypothetische Frage (ich bin schwer am lernen) - Wenn ich CheckBox 1 bis Checkbox 15 ansprechen möchte, wie müsste dann der Code heißen?

If Sheets("Tabelle1").OLEObjects("CheckBox" & cbnr 1 to 15).Object.Value = True Then

geht ja nicht wirklich.

VG
Florian

Answer 8

Noch kurz zum besseren Verständnis:

CheckBox 1 bis 15 sollen mit der Farbe 15, die CheckBox 16 bis 30 sollen mit Farbe 4 angesprochen werden.

VG
Florian

Answer 9

Hallo Florian,

das musst du mit einer IF-Abfrage machen; ungefähr so:

Public cbnr As Long

Sub faerben_neu()
Dim zeile, farbe As Long

zeile = Sheets("Tabelle1").OLEObjects("CheckBox" & cbnr).TopLeftCell.Row

If Sheets("Tabelle1").OLEObjects("CheckBox" & cbnr).Object.Value = True Then
If cbnr <16 Then
farbe = 15
Else
farbe = 4
End If
ActiveSheet.Range(Cells(zeile, 1), Cells(zeile, 15)).Font.ColorIndex = farbe
Else
ActiveSheet.Range(Cells(zeile, 1), Cells(zeile, 15)).Font.ColorIndex = 1
End If

End Sub

Gruß

M.O.

Answer 10

Vielen vielen Dank.

Ich glaube, langsam komm ich mit.

VG
Florian