Office: (Office 2013) einzelnes Blatt mit VBA Passwort sperren

Dann entschuldige, ich habe nicht erkannt, dass es bei der Aufhebung per Button um die übrigen Tabellenblätter ging. Ich war immer noch lediglich bei dem Startblatt.
Also hat jedes Blatt (2018,2019,...) einen Button? Und der Blattschutz soll dann auch erst mit Schließen wieder aktiviert werden?
Da ließe sich bestimmt noch eine etwas sauberer programmierte Lösung erarbeiten.

 

Richtig jedes Blatt hat einen Button aktueller Code:

in DieserArbeitsmappe:

PHP:

         Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim WsTabelle As Worksheet
For Each WsTabelle In Sheets
WsTabelle.Protect "XY", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, AllowFiltering _
:=True, AllowUsingPivotTables:=True
Next WsTabelle
End Sub


 

Code:

Diesen Code in ein allgemeines Modul schreiben und das Makro "entsperren" für jeden Button hinterlegen.
Im Workbook_BeforeClose Ereignis dann noch dass sperren Makro aufrufen

Code:

Zur Funktion: Das Passwort wird abgefragt. Ist es richtig werden das Worksheet und das zugehörige Passwort jeweils in einem wachsenden Array abgelegt. Beim schließen wird dann jedes entsperrte Blatt wieder mit dem richtigen Passwort und den von dir gewünschten Einstellungen gesperrt. Damit ist im Übrigen auch die Möglichkeit abgedeckt, das die Blätter unterschiedliche Passwörter haben könnten.

Besten Gruß

 

Hab folgendes eingefügt in allen Tabellen.
Leider ist intZaehler nicht definiert so ist zumindest die Fehlerangabe

PHP:

         Private strPassword() As String
Private wksEntsperrt() As Worksheet
Private intZaehler As Integer

Public Sub entsperren()
Dim strPW As String
Dim wks As Worksheet

strPW = InputBox("Passwort eingeben:")
Set wks = ActiveSheet

ReDim Preserve strPassword(intZaehler)
ReDim Preserve wksEntsperrt(intZaehler)

On Error GoTo Falsch
wks.Unprotect strPW
On Error GoTo 0
strPassword(intZaehler) = strPW
Set wksEntsperrt(intZaehler) = wks
intZaehler = intZaehler + 1
Exit Sub
Falsch:
MsgBox "Falsches Passwort"
End Sub

Public Sub sperren()
Dim i As Integer

For i = 0 To intZaehler - 1
wksEntsperrt(i).Protect Password:=strPassword(i), DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, AllowFiltering _
:=True, AllowUsingPivotTables:=True
Next

End Sub

Public Sub Blattschutz_aufheben_Click()
Call entsperren
End Sub


 

Hast du den Code in jedes einzelne Blattmodul geschrieben?
Der sollte in ein allgemeines Modul.

Der Zähler ist genau genommen am Anfang auch nicht definiert. Bei mir läuft der Code allerdings Problemlos.

Code:

Die rot makierte Zeile ist bei mir wahr.

 

Okay funktioniert.

Nur ist es leider so das man nicht weis ob man gerade ein neues Passwort vergibt oder ob man das Blatt gerade entsperrt. Vielleicht sollte da noch ein Kommentar hinzugefügt werden das verdeutlicht das jetzt ein neues Passwort vergeben wird.

 

Jetzt funktioniert alles vielen Dank für die Hilfe

 

Also eigentlich wird kein neues Passwort vergeben. Es wird ja nur entsperrt, wenn vorher das richtige "alte" Passwort eingegeben wurde.