Hallo,
ich habe vor auf mehrere Arbeitsmappen einen Blattschutz zu setzen. Um nicht immer über Schutz - Blatt schützen zu gehen hab ich eine Makro Lösung erarbeitet.
Der Quellcode stimmt und macht auch das was ich will, nur werden beim Aufheben (Makro) und anschließender Eingabe von Werten die Tabellen nicht richtig angezeigt. Es kommt zu einem kurzen flackern bzw. zu einem verschieben der Spalten. Scrollt man nach unten bzw. oben verschwindet der Grafikfehler wieder.
Das Makro ist wie folgt aufgebaut:
Beim Öffen der Datei wird in "DieseArbeitsmappe" das Makro BsAktiv aufgerufen. Siehe Modul 2
Inhalt DieseArbeitsmappe
Option Explicit
Private Sub Workbook_Open()
BsAktiv 'Aktualisiert beim Start der Mappe den Blattschutz
End Sub
--> dies funktioniert und hat keine Grafikfehler.
...nun zu Modul 1, wo ich den Fehler vermute. Über zwei Schaltflächen wird die Funktion "Blattschutz Aufheben" bzw. "Blattschutz Setzen" aufgerufen. Wird jetzt der Blattschutz aufgehoben und man gibt einen x- beliebigen Wert ein, so entsteht der beschriebene Fehler.
Modul1:
Option Explicit
Const BlSchutz = "sfend" 'Passwort für Blattschutz
'************************
'* Blattschutz Aufheben *
'************************
Sub Aufheben()
Application.ScreenUpdating = False
Dim wks As Worksheet
Dim Pwd As String
Pwd = Application.InputBox("Passwort eingeben:") 'speichert akt. Passwort (Eingabe)
If Pwd = BlSchutz Then 'vergl. akt. Passwort mit Bl.-schutz
For Each wks In ActiveWorkbook.Worksheets 'öffnet alle Blätter der Mappe
wks.Unprotect Password:=Pwd 'Bl.-schutz aufheben
wks.Columns("B:C").EntireColumn.Hidden = False 'Spalte A verstecken
wks.Columns("G:L").EntireColumn.Hidden = False
wks.Columns("AX:AZ").EntireColumn.Hidden = False
wks.Columns("BF:FF").EntireColumn.Hidden = False
Next wks 'nächstes Blatt
Else
MsgBox "Falsches Passwort"
End If
Application.ScreenUpdating = True
End Sub
'**********************
'* Blattschutz Setzen *
'**********************
Sub Setzen()
Application.ScreenUpdating = False
Dim wks As Worksheet
Dim wks1 As Worksheet
Dim Pwd As String
Set wks1 = ActiveSheet
Pwd = Application.InputBox("Passwort eingeben:") 'speichert akt. Passwort (Eingabe)
If Pwd = BlSchutz Then 'vergl. akt. Passwort mit Bl.-schutz
For Each wks In ActiveWorkbook.Worksheets 'öffnet alle Blätter der Mappe
wks.Protect Password:=Pwd, UserInterfaceOnly:=True, _
DrawingObjects:=False, AllowFormattingCells:=True 'Blatt schützen: Passwort,
'Änderung nur VBA, Objekte bearbeiten - ok
wks.Columns("B:C").EntireColumn.Hidden = True 'Spalte A verstecken
wks.Columns("G:L").EntireColumn.Hidden = True
wks.Columns("AX:AZ").EntireColumn.Hidden = True
wks.Columns("BF:FF").EntireColumn.Hidden = True
ActiveSheet.EnableSelection = xlUnlockedCells 'keine gesperrten Zellen auswählbar
Next wks 'nächstes Blatt
Else
MsgBox "Falsches Passwort"
End If
Sheets("Schichtplan").Select
Columns("A:X").EntireColumn.Hidden = False
Sheets("Eingabe_MA").Select
Columns("B:C").EntireColumn.Hidden = False
Columns("G:L").EntireColumn.Hidden = False
Application.ScreenUpdating = True
wks1.Activate
End Sub
-------------------------------------------------------------------------------------------------------------
Modul2
Option Explicit
Const BlSchutz = "sfend" 'Passwort für Blattschutz
Sub BsAktiv()
Application.ScreenUpdating = False
Dim wks As Worksheet
Dim wks1 As Worksheet
Set wks1 = ActiveSheet
For Each wks In Worksheets
wks.Activate
wks.Unprotect Password:=BlSchutz
wks.Columns("B:C").EntireColumn.Hidden = True 'Spalte A verstecken
wks.Columns("G:L").EntireColumn.Hidden = True
wks.Columns("AX:AZ").EntireColumn.Hidden = True
wks.Columns("BF:FF").EntireColumn.Hidden = True
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect Password:=BlSchutz, UserInterfaceOnly:=True, DrawingObjects:=False, _
AllowFormattingCells:=True
End With
Next wks
Sheets("Schichtplan").Select
Columns("A:X").EntireColumn.Hidden = False
Sheets("Eingabe_MA").Select
Columns("B:C").EntireColumn.Hidden = False
Columns("G:L").EntireColumn.Hidden = False
Application.ScreenUpdating = True
wks1.Activate
End Sub
Vielen Dank für Eure Mühe