AW: Schutz aufheben
CitizenX
Hallo Walter,
hier mal eine Möglichkeit für die Passwortabfrage.
Der User hat 3 mal die Möglichkeit das Passwort einzugeben.
Wenn das Passwort richtig ist wird der Blattschutz aufgehoben und die UF "geschlossen".
Option Explicit
Private Sub Blattschutz()
Dim myPass$, myInput, myTry%, myString$
'Anzahl der Möglichen Eingaben
Const Anz = 3
'Wenn Blattschutz gesetzt dann Passwortabfrage
If Sheets("Muster").ProtectContents Then
'Passwort für den Blattschutz
myPass = "mein passwort"
myString = "Bitte geben Sie das Passwort ein."
Do
myInput = InputBox(myString, "Schutz aufheben")
myString = "Falsches Kennwort." & Chr(13) & _
"Nur bei Herrn Busch zu erfragen !" & String(2, Chr(13)) & _
"Sie haben noch " & Anz - myTry & " Versuch(e)!"
myTry = myTry + 1
'Passwort ist richtig
If myInput = myPass Then Exit Do
'Abbrechen gewählt
If StrPtr(myInput) = 0 Then Exit Sub
'Mehrfache Falscheingabe
If myTry - 1 = Anz Then Exit Sub
Loop
Sheets("Muster").Unprotect passwort:=myPass
Unload Me 'Wenn Code in Userform dann UF schließen
End If
End Sub
Grüße
Steffen