Hallo,

ich habe ein Problem bei der ANwedung von Makros und aktiviertem Blattschutz.

Anwendung:

Ich habe eine einfache Klassenliste zusammen getragen. Diese hat einfache Dokumentsteuerelemente die zum Filtern und Speichern benutzt werden, die entsprechende Makros zugewisen bekommen haben.

Filter: nach Klassen filter etc. (

Speichern: Bei Betätigung dieses Buttons wird a) Die Liste neu sortiert und b) die das Dokumenten unter einem Neuem neuen Dateinamen mit Datum/Zeitstempel gespeichert, eine Änderungshistorie nachvollziehen zu können.

Problem:

Blattschutz wird aktiviert und er Benutzer kann nur einen bestimmten Zellbereich bearbeiten. Zudem wird im Blattschutz die Funktion "Zeilen Löschen", "Sortieren" und "Autofilter Verwenden" aktiviert.

Blattschutz mit diesen Attributen funktioniert bis zu dem Zeitpunkt, an dem das Speichern über das Steuerelement ausgeführt wird und das Dokument als neue Datei gespeichert wird. Die neue Datei hat zwar einen Blattschutz, aber sie hat die Blattschutz Attribute "Zeilen Löschen", "Sortieren" und "Autofilter Verwenden" deaktiviert, so dass nicht mehr möglich ist z.B. die Filter zu bedienen oder Zeilen zu löschen.

Anbei der Code Snippet welcher dem Steuerlelement zugewiesen ist.

Sub SpeichernSortieren()
'
' SpeichernSortieren Makro
' Sopeichert und Sortiert die Liste
'
ActiveSheet.Protect UserInterfaceOnly:=True, Password:="***"
'
    ActiveWorkbook.Worksheets("Schüler Liste").ListObjects("Tabelle1").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Schüler Liste").ListObjects("Tabelle1").Sort. _
        SortFields.Add Key:=Range("Tabelle1[Ort]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, CustomOrder:= _
        "Krippe,Kindergarten,Vorschule,Klasse 1,Klasse 2,Klasse 3,Klasse 4,Klasse 5,Klasse 6,Klasse 7,Klasse 8,Klasse 9,Klasse 10" _
        , DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Schüler Liste").ListObjects("Tabelle1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
        
Dim Datumzeitstempel As String
Dim Jetzt As Date
Jetzt = Now()
Dateiname = "Klassenliste Phone EMail"
Datumzeitstempel = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
Datumzeitstempel = Dateiname & " " & Datumzeitstempel & "-" & Format(Hour(Jetzt), "00") & Format(Minute(Jetzt), "00") & Format(Second(Jetzt), "00")
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & Datumzeitstempel & ".xlsm")

    
End Sub

GIbt es eine Möglichkeit die Blattschutzattribute, wie angewählt, in die neue Datei automatisch mit zu übernehmen? Mit normal "speichern unter", bleibt der Blattschutz erhalten wie er soll.

VG

Peter