Blattschutzeigenschaften mit Makro

Sub schutzAn()
protectAllSheets "E:\Forum", "DeinPasswort", True
End Sub

Sub schutzAus()
protectAllSheets "E:\Forum", "DeinPasswort", False
End Sub

Sub protectAllSheets(Directory As String, Password As String, Protection As Boolean)
Dim objWB As Workbook, objSH As Worksheet
Dim strFile As String, strDir As String
Dim lngCalc As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
strDir = IIf(Right(Directory, 1) = "\", Directory, Directory & "\")
strFile = Dir(strDir & "*.xls*", vbNormal)
Do While strFile  ""
If strDir & strFile  ThisWorkbook.FullName Then
Set objWB = Workbooks.Open(strDir & strFile, UpdateLinks:=False)
For Each objSH In objWB.Worksheets
If Protection Then
objSH.Protect Password
Else
objSH.Unprotect Password
End If
Next
objWB.Close True
End If
strFile = Dir
Loop
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'protectAllSheets'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Modul1"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
Set objWB = Nothing
Set objSH = Nothing
End Sub