Habe ein PGM geschrieben, dass alle .xls Datein eines Ordners (+Unterornder) oeffnet, Kopfzeile aendert, Dokument speichert und danach wieder schliesst.
Mein Problem ist aber, dass die Kopfzeile nur in der aktiven Tabelle einer Excel-Datei geaendert wird und in den restlichen Tabellen nicht.
Code:
Sub kopfzeile()
Dim kopfzeile As String
Dim Pfad As String
Dim I As Long
kopfzeile = InputBox("Bitte geben Sie den Inhalt der Kopfzeile an:", "Kopfzeile Eingabe", "Kopfzeile 1")
' Abbrechen wird gedrückt
If StrPtr(kopfzeile) = 0 Then
Exit Sub
End If
Pfad:
Pfad = InputBox("Bitte überprüfen sie den Pfad:", "Pfad Eingabe", "C:\Ordner1\")
' Abbrechen wird gedrückt
If StrPtr(Pfad) = 0 Then
Exit Sub
' Eingabe ist leer
ElseIf Pfad = "" Then
GoTo Pfad
' Pfad nicht vorhanden
ElseIf Dir(Pfad, vbDirectory) = "" Then
MsgBox "Pfad existiert nicht!" & " " & Pfad, vbExclamation
GoTo Pfad
End If
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = Pfad
'Suchen auch in Unterverzeichnissen
.SearchSubFolders = True
On Error Resume Next
.Filename = "*.xls"
If .Execute() > 0 Then
For I = 1 To .FoundFiles.Count
' .xls Dateien öffnen, Verknüpfungen nicht aktualisieren
Workbooks.Open .FoundFiles(I), updatelinks:=0
' Kopfzeile wird geändert
ActiveSheet.PageSetup.CenterHeader = kopfzeile
ActiveWorkbook.Close True
Next I
End If
End With
Application.ScreenUpdating = True
MsgBox "Fertig!", vbInformation
End Sub
Ich hoffe Ihr koennt mir einen Tip geben diesbezueglich!
Danke
LG Harry