Sub
makro_filename()
Dim
MyPath
As
String
, FilesInPath
As
String
Dim
MyFiles()
As
String
, Fnum
As
Long
Dim
mybook
As
Workbook
Dim
CalcMode
As
Long
Dim
sh
As
Worksheet
Dim
ErrorYes
As
Boolean
MyPath =
"irgendeinpfad"
FilesInPath = Dir(MyPath &
"*.xl*"
)
If
FilesInPath =
""
Then
MsgBox
"Keine Dateien gefunden"
Exit
Sub
End
If
Fnum = 0
Do
While
FilesInPath <>
""
Fnum = Fnum + 1
ReDim
Preserve
MyFiles(1
To
Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
With
Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating =
False
.EnableEvents =
False
End
With
If
Fnum > 0
Then
For
Fnum = LBound(MyFiles)
To
UBound(MyFiles)
Set
mybook =
Nothing
On
Error
Resume
Next
Set
mybook = Workbooks.Open((MyPath & MyFiles(Fnum)), , , , Password:=
"password"
)
On
Error
GoTo
0
If
Not
mybook
Is
Nothing
Then
On
Error
Resume
Next
For
Each
sh
In
mybook.Worksheets
If
sh.ProtectContents =
False
Then
With
sh
.PageSetup.LeftFooter =
"Form-Nr. "
& mybook.Name
.Range(
"A7:I11"
).Interior.Color = RGB(224, 224, 224)
End
With
Else
ErrorYes =
True
End
If
Next
sh
If
Err.Number > 0
Then
ErrorYes =
True
Err.Clear
mybook.Close savechanges:=
False
Else
mybook.Close savechanges:=
True
End
If
On
Error
GoTo
0
Else
ErrorYes =
True
End
If
Next
Fnum
End
If
If
ErrorYes =
True
Then
MsgBox
"There are problems in one or more files, possible problem:"
_
& vbNewLine &
"protected workbook/sheet or a sheet/range that not exist"
End
If
With
Application
.ScreenUpdating =
True
.EnableEvents =
True
.Calculation = CalcMode
End
With
End
Sub