AW: Klappt, aber Problem wenn Code 3 Listobject's betifft
02.02.2024 13:43:57
FranziskusV
Hallo Thorsten,
Ich habe meine Reaktion oben an die falsche Stelle im Thread gesetzt.
Dein Code funktionniert. Danke ! Ich habe eine farbliche Hervorhebung und auch das Entsperren und Entfernen der Hervorhebung noch hinzu gesetzt. Ausserdem ein bisschen mehr Sicherheit gegenüber Endlosschleifen. Auch das hat sehr gut geklappt.
So sieht der Code dann aus.
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Der Code startet"
' Überprüfe, ob Ereignisse aktiviert sind
If Not Application.EnableEvents Then Exit Sub
' Deaktiviere Ereignisse, um Endlosschleifen zu verhindern
Application.EnableEvents = False
With ListObjects(1) ' Anpassung auf Index 1
If Target.Column = .ListColumns.Count Then
ActiveSheet.Unprotect ' Blattschutz aufheben
' Überprüfe, ob in der letzten Spalte "Ja" oder "Nein" steht
If UCase(Target.Value) = "JA" Then
Intersect(.DataBodyRange, Target.EntireRow).Locked = True
Intersect(.DataBodyRange, Target.EntireRow).Interior.Color = RGB(211, 236, 185)
ElseIf UCase(Target.Value) = "NEIN" Then
Intersect(.DataBodyRange, Target.EntireRow).Locked = False
Intersect(.DataBodyRange, Target.EntireRow).Interior.ColorIndex = xlNone ' Zurücksetzen der Hervorhebung
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
End If
End With
End Sub
Das funktioniert also.
Aber wie häufig im Leben gibt es noch ein kleines Aber. Denn eigentlich habe ich auf dem Tabellenblatt 3 verschiedene Listobject's mit Index 1 bis 3. Jedes dieser Listobject's hat eine letzte Spalte wo man validieren können soll. In in diesen intelligenten Tabellen soll bei "Ja" in der letzten Spalte auch die ganze Zeile farblich hervorgehoben und gesperrt werden (bzw bei "Nein" umgekehrt) . Ich habe versucht den Code diesbezüglich umzustricken. Aber das klappt leider nicht.
Mein Versuch sieht so aus :
Private Sub Worksheet_Change(ByVal Target As Range)
' Überprüfe, ob Ereignisse aktiviert sind
If Not Application.EnableEvents Then Exit Sub
' Deaktiviere Ereignisse, um Endlosschleifen zu verhindern
Application.EnableEvents = False
' Durchlaufe alle ListObjects auf dem aktuellen Tabellenblatt
Dim tbl As ListObject
For Each tbl In Me.ListObjects
If Target.Column = tbl.ListColumns.Count Then
Me.Unprotect ' Blattschutz aufheben
' Überprüfe, ob in der letzten Spalte "Ja" oder "Nein" steht
If UCase(Target.Value) = "JA" Then
Intersect(tbl.DataBodyRange, Target.EntireRow).Locked = True
Intersect(tbl.DataBodyRange, Target.EntireRow).Interior.Color = RGB(211, 236, 185)
ElseIf UCase(Target.Value) = "NEIN" Then
Intersect(tbl.DataBodyRange, Target.EntireRow).Locked = False
Intersect(tbl.DataBodyRange, Target.EntireRow).Interior.ColorIndex = xlNone ' Zurücksetzen der Hervorhebung
End If
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
End If
Next tbl
' Aktiviere Ereignisse wieder
Application.EnableEvents = True
End Sub
Hierbei wird das Listobjekt mit Index 1 korrekt angesprochen und da werden die erwünschten Veränderungen ausgeführt, sowohl mit "Ja" wie mit "Nein".
Bei den beiden anderen Listobjekten mit Index 2 bzw 3 jedoch passiert nichts wenn ich dort versuche mit "Ja" eine Zeile zu validieren (oder eben die Validierung aufzuheben). Mir ist eigentlich klar, dass mein Code nicht funktionieren kann....nur weiss ich nicht wie ich es besser machen könnte. Weitere Hilfe wäre daher schön.
Grundsätzlich könnten auch noch später weitere Listobjecte auf dem Tabellenblatt hinzukommen. Bei diesen sollte dann jedoch nicht jede Zeile validiert werden. Das Ganze soll sich also begrenzen auf Case 1-3 wenn der Index der Listobects entsprechend ist.
Aber das zu machen übersteigt meine Kenntnisse.
Vielleicht findet sich ja noch einmal ein Helfer.
LG,
FranziskusV