Zellen sperren und entsperren
09.10.2013 23:37:07
Justi
dank dieses genialen Forums habe ich ein Makro von Basti zu folgendem Problem erhalten:
ich habe eine Excel-Tabelle (Blattschutz aktiv) in der von verschiedenen Bearbeitern Daten eingetragen werden. Die eingetragenen Daten werden durch einen zweiten Bearbeiter geprüft. Ist der Eintrag OK, wird in einer Zelle nach den Einträgen ein "c" eingetragen. Die Zellen (n-3) und (n-4),in Relation zur Zelle in der "c" eigetragen wurde, werden automatisch gesperrt.
Wird das c gelöscht werden die Zellen durch Passwortabfrage wieder entsperrt.
Das Makro funktioniert super. Nur kann ich den Autofilter nicht anwenden (das habe ich in etwa hinbekommen indem ich AllowFiltering:=True ergänzt habe; funktioniert allerdings nur wenn ich eine Zelle mit c eingetragen habe; ansonsten nicht). Auch ein/ausblenden der Gliederung funktioniert bei eingeschaltetem Blattschutz nicht. Die beiden Funktionen müssen aber in jedem Fall verwendet werden können.
Kann mir da nochmal jemand helfen?
Option Explicit
Dim strAlterWert As String
Dim strPasswort As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A:P"), Target) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "C" Or Target.Value = "c" Then
ActiveSheet.Unprotect
Target.Offset(0, -3).Locked = True
Target.Offset(0, -4).Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
If strAlterWert = "C" Or strAlterWert = "c" Then
strPasswort = InputBox("Bitte Passwort eingeben")
Select Case strPasswort
Case "1234"
ActiveSheet.Unprotect
Target.Offset(0, -3).Locked = False
Target.Offset(0, -4).Locked = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Case Else
Application.EnableEvents = False
Target.Value = strAlterWert
Application.EnableEvents = True
Exit Sub
End Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Range("A:P"), Target) Is Nothing Then Exit Sub
strAlterWert = Target.Value
End Sub
Viele Grüße
Justi
Anzeige