Haken in Checkbox löschen wenn zelle in Spalte E leer ist

Question

Hallo zusammen,

ich habe mir eine Tabelle mit ca. 60 Checkboxen erstellt. Diese habe ich fest mit Zellen verbunden. Nun möchte ich, dass wenn ich in Spalte "E" den enthaltenen Text / Zahl lösche, dass die Haken der Checkboxen in dieser Zeile geschlöst werden.

Beim anklicken der Checkboxen färbe ich den Text ein, bzw. beim entfernen vom Haken wieder auf Standart Schwarz zurück. Die Checkboxen befinden sich in Spalte J und O.

Den Code für das löschen der anderen Spalten in einer Zeile / färben habe ich folgender Maßen gelöst:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then _
Intersect(Target.EntireRow, Range("A:B,F:F,K:P")).ClearContents
EnableDisable
End Sub


Private Sub CheckBox1_Click()
cbnr = 1
Call faerben
End Sub

Private Sub CheckBox2_Click()
cbnr = 2
Call faerben
End Sub
....

Gibt es eine Möglichkeit, dass ich nicht für jede Checkbox einen neuen Code erstellen muss, sondern einen für alle Checkboxen zusammen zu fügen? (faerben und löschen)

Vielen Dank.

Gruß Florian

Answer 1

Hallo Florian,

Mit Formularcheckboxen geht das nicht. Dazu brauchst du ActiveX-Checkboxen. Mit folgendem Code wandelst du die Formularcheckboxen in ActiveX-Elemente um. (Nicht nötig sofern du bereits ActiveX-Checkboxen verwendest):

Sub CheckBoxErsetzen()

'ersetzt Formular-Checkboxen durch ActiveX-Checkboxen

Dim bx As OLEObject

For Each shp In ActiveSheet.Shapes
If shp.Type = msoFormControl Then
If shp.FormControlType = xlCheckBox Then

Set bx = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1")

bx.Top = shp.Top
bx.Left = shp.Left
bx.Width = shp.Width * 130 / 100
bx.Height = shp.Height
bx.LinkedCell = shp.ControlFormat.LinkedCell
bx.Name = shp.Name
bx.Object.Caption = shp.TextFrame.Characters.Text

shp.Delete

End If
End If
Next shp

End Sub

Erstelle nun über Einfügen ein neues Klassenmodul "Klasse1" und füge dort folgenden Code ein:

Public WithEvents cbx As msforms.CheckBox

Sub cbx_click()

On Error Resume Next

cbnr = Val(Right(cbx.Name, Len(cbx.Name) - 8))

If cbx.Value = True Then
'färben
Cells(Range(cbx.LinkedCell).Row, 5).Font.Color = -16776961
Else
'entfärben
Cells(Range(cbx.LinkedCell).Row, 5).Font.ColorIndex = xlAutomatic
End If

MsgBox "Checkbox" & cbnr & " wurde geändert"

End Sub

Im Modul "Diese Arbeitsmappe" fügst du dann diesen Code ein:

Dim cb() As New Klasse1
Private Sub Workbook_Open()

ReDim cb(1 To Tabelle1.OLEObjects.Count)

For bx = 1 To Tabelle1.OLEObjects.Count
If InStr(1, Tabelle1.OLEObjects(bx).progID, "CheckBox") > 0 Then
Set cb(bx).cbx = Tabelle1.OLEObjects(bx).Object
End If
Next bx

End Sub

Schließlich fügst du noch in deinem Blattmodul, diesen Code ein:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 5 And IsEmpty(Target.Value) Then
Intersect(Target.EntireRow, Range("A:B,F:F,K:P")).ClearContents

Cells(Target.Row, 5) = False 'setzt die linked Cell auf False
Cells(Target.Row, 15) = False 'damit das Häkchen verschwindet
End If

End Sub

L.G. Mr. K.