Blattschutz mit Abfragefenster

Sub Blattschutz_aus() Dim TB As Variant, msg As Byte msg = MsgBox("xxx", vbYesNo) If msg = vbYes Then Application.ScreenUpdating = False For Each TB In ActiveWorkbook.Sheets TB.Unprotect Password:="pw" Next MsgBox "Der Schutz ist nun aufgehoben !", 64 + 0, "Hinweis:" End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Blattschutz_aus() Application.ScreenUpdating = False Dim TB As Variant, msg As String msg = InputBox("Passwort?", "Frage", vbOKCancel) If msg = "" Then Exit Sub For Each TB In ActiveWorkbook.Sheets TB.Unprotect Password:=msg Next MsgBox "Der Schutz ist nun aufgehoben !", 64 + 0, "Hinweis:" Application.ScreenUpdating = True End Sub

Hallo David,
also im Großen und Ganzen funktioniert es, aber leider nur spartanisch. Z.b. bei einer falschen Eingabe springt Excel in den VB Editor.
Vor der Passwortabfrage müsste ein Fenster erscheinen was abfragt, ob der Passwortschutz aufgehoben werden soll oder nicht. Hier müssten dann die Button "OK" und "Abbrechen" zur Auswahl stehen.
Bei "OK" müsste das Fenster mit der Passwortabfrage erscheinen. Allerdings ohne eine enthaltene Eingabe, zur Zeit steht dort eine "1". Die Auswahlbuttons "OK" und "Abbrechen" müssten hier ebenfalls zur Auswahl stehen.
Sollte nun ein falsches PW eingegeben werden, müsste eine negative Meldung kommen. Z.B. "Die Eingabe war falsch. Soll dieser Vorgang abgebrochen werden?" Hier müsste man dann wieder die Auswahl zwischen zwei Auswahlbuttons haben. Bsp.: "OK" und "Passworteingabe". Bei "OK" müsste abgebrochen werden und bei "Passworteingabe" wieder ein Fenster kommen wo man seine PW Eingabe wiederholen und bestätigen kann.
Gruß aus SH
André

Sub Blattschutz_aus() Dim TB As Variant Dim psw As Variant psw = InputBox("Wenn der Blattschutz aufgehoben werden soll, bitte Passwort eingeben!", " _ Passwortabfrage") If psw "" Then ' Nachfolgende Zeilen sind als Rückmeldung gedacht, wenn ALLE Blätter das selbe Passwort haben ' If psw "Testpaswort" Then ' MsgBox "Falsches Passwort", vbCritical + vbOKOnly, "Fehler" ' Exit Sub ' End If Application.ScreenUpdating = False For Each TB In ActiveWorkbook.Sheets TB.Unprotect Password:="pw" Next MsgBox "Der Schutz ist nun aufgehoben !", 64 + 0, "Hinweis:" End If End Sub

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Blattschutz mit Abfragefenster

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread