Worksheet_Change vs Blattschutz
11.10.2019 14:33:16
EasyD
Werner hat mir bei den unten aufgeführten Code schon extrem geholfen.
Ich bin mir nicht sicher ob das mit dem Referenzieren auf den ursprünglichen Beitrag hier so klappt:
https://www.herber.de/forum/archiv/1716to1720/1716862_Zellen_Sperren_mit_Worksheet_Change.html
Das läuft auch prima, jetzt will ich aber weiterhin die gleiche oder zumindest ähnliche Abfrage auch in einem anderen Bereich auf dem gleichen Blatt machen. Sprich - bspw wenn Zelle A1 nicht leer, dann Zelle A2 sperren.
Kriege ich das im gleichen Worksheet_Change überhaupt hin?
Das Problem ist ja der Blattschutz - ich hebele die Ausführung des Blattschutz-Befehles aus mit Exit Sub wenn ich mich nicht in dem Bereich der unten abgehandelt wird befinde und A1 und A2 sind ja genau solche Zellen. Und das Exit Sub heißt dann, keine Ausführung wenn A1 oder A2 ausgewählt (oder auch alle anderen Zellen des Blattes außer den Bereich unten)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellsE As Range, CellsF As Range, CellsG As Range, CellsGes As Range, CellsIcon As Range
'Zellbereiche definieren
Set CellsE = Range("E91:E95")
Set CellsF = Range("F91:F95")
Set CellsG = Range("G91:G95")
Set CellsGes = Range("E91:G95")
Set CellsIcon = Range("Y11")
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'das hier spielt für die Frage keine Rolle
'Notiz-Icon anzeigen, wenn Antragsdatum_Abw nicht leer
ActiveSheet.Shapes.Range(Array("Picture 9")).Visible = CellsIcon ""
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'hier noch eine Beschränkung, sonst wird bei jeder
'Zelländerung, egal wo auf dem Blatt, der Blattschutz
'rausgenommen und wieder gesetzt
'xxxxxxxxxx
' Hier liegt das Problem
If Intersect(CellsGes, Target) Is Nothing Then Exit Sub
'xxxxxxxxxx
Call Protect_off
If Not Intersect(CellsGes, Target) Is Nothing Then
'Wenn alle Zellen leer, dann den ganzen Bereich entsperren
'Wenn Änderungen in Spalte E:
If Not Intersect(CellsE, Target) Is Nothing Then
Application.EnableEvents = False
With CellsE.Interior
.Pattern = xlNone
End With
CellsF.ClearContents
CellsG.ClearContents
CellsF.Locked = True
CellsG.Locked = True
With CellsF.Interior
.Color = 15652797
End With
With CellsG.Interior
.Color = 15652797
End With
Application.EnableEvents = True
End If
'Wenn Änderungen in Spalte F:
If Not Intersect(CellsF, Target) Is Nothing Then
Application.EnableEvents = False
With CellsF.Interior
.Pattern = xlNone
End With
CellsE.ClearContents
CellsG.ClearContents
CellsE.Locked = True
CellsG.Locked = True
With CellsE.Interior
.Color = 15652797
End With
With CellsG.Interior
.Color = 15652797
End With
Application.EnableEvents = True
End If
'Wenn Änderungen in Spalte G:
If Not Intersect(CellsG, Target) Is Nothing Then
Application.EnableEvents = False
With CellsG.Interior
.Pattern = xlNone
End With
CellsE.ClearContents
CellsF.ClearContents
CellsE.Locked = True
CellsF.Locked = True
With CellsE.Interior
.Color = 15652797
End With
With CellsF.Interior
.Color = 15652797
End With
Application.EnableEvents = True
End If
'wenn keine Eintragungen, dann alle 3 Spalten entsperren, damit
'in jeder Spalte Eintragungen vorgenommen werden können.
'Erst sobald eine Spalte bearbeitet wird, startet der Code
If Application.CountA([E91:G95]) = 0 Then
CellsE.Locked = False
CellsF.Locked = False
CellsG.Locked = False
With CellsE.Interior
.Pattern = xlNone
End With
With CellsF.Interior
.Pattern = xlNone
End With
With CellsG.Interior
.Pattern = xlNone
End With
End If
End If
Call Protect_on
Set CellsE = Nothing: Set CellsF = Nothing: Set CellsG = Nothing: Set SellGes = Nothing: Set _
_
CellsIcon = Nothing
End Sub