AW: Eigenschaften + Fusszeilen ändern in Dateien
15.06.2012 14:22:37
fcs
Hallo Stefan,
so eine Bearbeitung geht nur per Makro.
Nachfolgend ein entsprechendes Makro. Am besten mal mit einer Datei in einem Verzeichnis testen!!!
Es gibt von Excel 2010/2007 eine Inkompatibilität bezüglich der Kennbuchstaben für die Datenfelder (Dateiname und Seitenzahlen) mit älteren Excelversionen. Ich weiß aber nicht mehr genau, ob bis Excel 97 oder noch bis Excel 2003.
Gruß
Franz
'Erstellt unter Excel 2010
Sub Fusszeile_Eigenschaften()
'Ändert die Fusszeilen und die eingebauten Dokumenteigenschaften _
in allen Dateien des gewählten Verzeichnisses
Dim strOrdner As String, strFile As String, StatusCalc As Long, iCount As Integer
Dim wbk As Workbook, wks As Worksheet
StatusCalc = Application.Calculation
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner mit den Dateien wählen, die bearbeitet werden sollen"
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If MsgBox("Sollen in den Dateien im Ordner" & vbLf & strOrdner & vbLf _
& "Fusszeile und Eigenschaften geändert werden?", _
vbQuestion + vbYesNo, _
"Sicherheitsabfrage!") = vbNo Then GoTo Beenden
strFile = Dir(strOrdner & "\*.xls*")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Do Until strFile = ""
If strFile ThisWorkbook.Name Then
iCount = iCount + 1
Application.StatusBar = "Bearbeite Datei " & iCount & " - " & strFile
Application.DisplayAlerts = False
Set wbk = Workbooks.Open(Filename:=strOrdner & "\" & strFile, addtomru:=False)
Application.DisplayAlerts = True
For Each wks In wbk.Worksheets
With wks.PageSetup
'Buchstaben für variable Felder gelten für Excel 2010/2007
.LeftFooter = "&D"
.CenterFooter = "&F"
.RightFooter = "&P von &N"
'bei älteren Exelversionen (Office 97 mit Sicherheit, 2003 ?) können die Buchstaben _
_
anders sein - wahrscheinlich.:
' .LeftFooter = "&[D]"
' .CenterFooter = "&[N]"
' .RightFooter = "&[S] von &[A]"
End With
Next wks
wbk.BuiltinDocumentProperties("Subject") = ""
wbk.BuiltinDocumentProperties("Title") = ""
wbk.BuiltinDocumentProperties("Author") = Application.UserName
' wbk.BuiltinDocumentProperties("Author") = "Stephan"
wbk.BuiltinDocumentProperties("Company") = ""
wbk.BuiltinDocumentProperties("Category") = ""
wbk.BuiltinDocumentProperties("Comments") = ""
wbk.BuiltinDocumentProperties("Manager") = ""
wbk.BuiltinDocumentProperties("Keywords") = ""
wbk.BuiltinDocumentProperties("Hyperlink base") = ""
wbk.Save
wbk.Close savechanges:=False
Else
MsgBox "Workbook mit gleichem Namen darf nicht geöffnet werden!", _
vbInformation, "Datei """ & strFile & """ öffnen"
End If
strFile = Dir
Loop
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Fertig"
End If
End With
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Beenden:
With Application
.StatusBar = False
.ScreenUpdating = True
.Calculation = StatusCalc
.EnableEvents = True
End With
End Sub