Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Blattschutz via Makro | Herbers Excel-Forum


Betrifft: Blattschutz via Makro von: Tinitus
Geschrieben am: 14.01.2010 09:59:47

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

  

Betrifft: AW: Blattschutz via Makro von: Reinhard
Geschrieben am: 14.01.2010 10:10:08

Hallo Tinitus,

ungetestet:

Sub BsAktiv()
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wks In Worksheets
   With wks
      .Unprotect Password:=BlSchutz
      .Range("B:C,G:L,AX:AZ,BF:FF").EntireColumn.Hidden = True 'Spalte A verstecken
      .EnableSelection = xlUnlockedCells
      .Protect Password:=BlSchutz, UserInterfaceOnly:=True, DrawingObjects:=False, _
               AllowFormattingCells:=True
   End With
Next wks
Sheets("Schichtplan").Columns("A:X").EntireColumn.Hidden = False
Sheets("Eingabe_MA").Columns("B:C").EntireColumn.Hidden = False
Sheets("Eingabe_MA").Columns("G:L").EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard


  

Betrifft: AW: Blattschutz via Makro von: Tinitus
Geschrieben am: 14.01.2010 10:32:26

Hallo Reinhard,

da das Problem nur auf Arbeit auftritt, kann ich es erst heute Abend testen. Der Quellcode scheint ja richtig zu sein, gibt es etwas bei der Aktualisierung, was ich vergessen haben könnte? Der Fehler tritt schließlich nur beim Aufheben bzw. Setzen des Blattschutzes auf. Modul 2 ist nicht betroffen.

Gruß
Micha


Beiträge aus den Excel-Beispielen zum Thema "Blattschutz via Makro"