Private
Sub
Workbook_SheetActivate(
ByVal
Sh
As
Object
)
Dim
Datum
As
Range
Set
Datum = Sh.Range(
"D5"
)
If
IsDate(Datum)
And
Datum <
Date
Then
If
Datum.Locked =
False
Then
Sh.Unprotect
"Passwort"
Sh.Cells.Locked =
True
End
If
Sh.Protect password:=
"Passwort"
If
Sh.ProtectContents
Then
Do
Passwort = InputBox(
"Diese Tabelle ist älter als heute und somit vor Eingabe geschützt. "
_
&
"Geben Sie das Passwort ein, um die Tabelle zu entschützen."
)
If
Passwort <>
""
Then
On
Error
GoTo
Fehler
Sh.Unprotect Passwort
On
Error
GoTo
0
End
If
Loop
Until
Not
Sh.ProtectContents
Or
Passwort =
""
End
If
End
If
Exit
Sub
Fehler:
MsgBox
"Das eingegebene Passwort ist ungültig"
Resume
Next
End
Sub