AW: Blattschutz von mehreren Excel-Dateien aufheben
15.11.2015 15:31:37
Sepp
Hallo Parza,
ungetestet!
' **********************************************************************
' Modul: Modul4 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub schutzAus()
Dim objWB As Workbook, objSh As Worksheet
Dim strFile As String, strPath As String
On Error GoTo ErrorHandler
Static CalculationMode As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
strPath = "E:\Forum" 'Verzeichnis - Anpassen!
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
Do While strFile <> ""
Set objWB = Workbooks.Open(strPath & strFile)
For Each objSh In objWB.Worksheets
objSh.Unprotect
Next
objWB.Close True
strFile = Dir
Loop
ErrorHandler:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'schutzAus'" & 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 Prozedur - schutzAus"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
Set objWB = Nothing
Set objSh = Nothing
End Sub
Sub schutzEin()
Dim objWB As Workbook, objSh As Worksheet
Dim strFile As String, strPath As String
On Error GoTo ErrorHandler
Static CalculationMode As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
strPath = "E:\Forum" 'Verzeichnis - Anpassen!
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
Do While strFile <> ""
Set objWB = Workbooks.Open(strPath & strFile)
For Each objSh In objWB.Worksheets
objSh.Protect
Next
objWB.Close True
strFile = Dir
Loop
ErrorHandler:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'schutzEin'" & 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 Prozedur - schutzEin"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
Set objWB = Nothing
Set objSh = Nothing
End Sub
Gruß Sepp