Private
Sub
Workbook_Open()
Workbook_SheetActivate ActiveSheet
End
Sub
Private
Sub
Workbook_SheetActivate(
ByVal
Sh
As
Object
)
Dim
Datum
As
Range
Set
Datum = Sh.Range(
"D5"
)
If
IsDate(Datum)
And
Datum <
Date
Then
Sh.Unprotect
"Passwort"
Sh.Cells.Locked =
True
Sh.Protect password:=
"Passwort"
If
Sh.ProtectContents
Then
Meldung
End
If
End
If
End
Sub
Sub
Meldung()
Dim
k
As
Integer
, Passwort
As
String
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
ActiveSheet.Unprotect Passwort
On
Error
GoTo
0
End
If
Loop
Until
Not
ActiveSheet.ProtectContents
Or
Passwort =
""
If
Passwort =
""
Then
For
k = 1
To
255
Application.OnKey
"{"
& k &
"}"
,
"DieseArbeitsmappe.Meldung"
Next
k
Else
For
k = 1
To
255
Application.OnKey
"{"
& k &
"}"
Next
k
End
If
Exit
Sub
Fehler:
MsgBox
"Das eingegebene Passwort ist ungültig"
Resume
Next
End
Sub