Office: mit VBA alle xlsx Datein nacheinander öffnen und ein Makro ausführen

senoyches · 15. Januar 2018

Hallo zusammen,

ich hätte folgende Frage:

Ich habe ein Makro entwickelt, das mir nach einem bestimmten Prinzip ein Logo und einen Schriftzug in die Kopfzeile einbindet und anschließen noch die Fußzeile ändert, dann auf nächste Tabellenblatt innerhalb der Mappe springt, dort das gleiche durchführt und wenn fertig mir noch ausgibt, wie viele Tabellenblätter bearbeitet wurden, damit ich das sauber dokumentieren kann, da so eine Mappe auch mal 80 - 85 Tabellenblätter enthalten kann, aber nicht muss, gibt auch welche mit lediglich 2.

Da ich aber von Natur aus faul bin, wollte ich das ganze mir noch etwas vereinfachen und Die erste Datei in dem jeweiligen Ordner öffnen, dann das Makro ausführen, dann werden alle Datein nacheinander geöffnet, die Aktion wie oben genannt ausgeführt und dann wieder geschlossen, ob alle geöffnet und dann am eine nach der anderen geschlossen oder nacheinander geöffnet und am Ende der Bearbeitung immer geschlossen, ist mir eigentlich egal, wobei ich vermuten könnte, das letztere Aktion weniger Rechenleistung fordert.

hier mein Code dazu:

Code:

Sub Makro_neu2017()
'
Dim user As String
'Den Computer und Usernamen auslesen um ihn später zu verwenden
user = Environ("COMPUTERNAME") + "/" + Environ("USERNAME")
Dim WS_Count As Integer
Dim I As Integer
Dim Dateiname As String
Dim Pfad As String
Dim Typ As String

WS_Count = ActiveWorkbook.Worksheets.Count
'Anzahl Tabellenblätter zählen
Pfad = ActiveWorkbook.Path & ""
'Pfad bestimmen
Typ = "*.xlsx"
'Dateityp bestimmen, der Datein die geöffnet werden sollen
Dateiname = Dir(Pfad & Typ)
'Alle Datein des angebenen Typs einlesen
MsgBox Pfad
'Kontrollausgabe während der Programmierung, ob der Pfad stimmt
Do While Dateiname ""
Workbooks.Open (Pfad & Dateiname)
For I = 1 To WS_Count

With ActiveWorkbook.Worksheets(I).PageSetup
'LeftHeader=Linker Teil der Kopfzeile - "&G" bedeutet, dass er eine Grafik beinhaltet
.LeftHeader = "&G"
'Den Pfad der Grafik angeben, muss geändert werden, wenn sich der Pfad der Vorlage ändert!
.LeftHeaderPicture.Filename = "C:ipm Vorlagen17.09.29 Pfad VorlageExcelPfadIPM - logo mittel.bmp"
'CenterHeader=Mittlerer Teil der Kopfzeile - "" -> Wird leer gemacht falls etwas drinsteht!
.CenterHeader = ""
'RightHeader=Rechter Teil der Kopfzeile - "&G" bedeutet, dass er eine Grafik beinhaltet
.RightHeader = "&G"
'Den Pfad der Grafik angeben, muss geändert werden, wenn sich der Pfad der Vorlage ändert!
.RightHeaderPicture.Filename = "C:ipm Vorlagen17.09.29 Pfad VorlageExcelPfadIPM - Textblock.png"
'Die Höhe der Grafik beschränken!
.RightHeaderPicture.Height = 40

'Fußzeile
'--------
.LeftFooter = "&""Segoe UI Light""&8Pfad: &Z" & Chr(10) & "File: &F" & Chr(10) & "Register: &A"
.CenterFooter = "&""Segoe UI Light""&8© - ipm"
.RightFooter = "&""Segoe UI Light""&8" + user + " " & "&D &T" & Chr(10) & "Seite &P von &N"
.HeaderMargin = 0
.TopMargin = Application.CentimetersToPoints(2)
End With
Debug.Print ActiveWorkbook.Worksheets(I).Name

Next I
ActiveWorkbook.Close True
'nächste Datei lesen
Dateiname = Dir()
MsgBox WS_Count
Loop
Application.DisplayAlerts = False
Workbooks("17.06.09 ipm - Makros - Kopf- und Fußzeile.xls").Close SaveChanges:=True
'
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich vermute den Fehler bei dem rot gefärbten Code Schnipsel, da ich nicht das Makro öffne und ausführen sondern wie oben beschrieben die erste Datei oder irgend eine Datei aus dem Ordner öffne und dann dann ein dort eingebundenes Makro, das ein einer ganz bestimmten Stelle auf der Festplatte auf einem jeden PC liegt nutze.

Allerdings habe ich keine Idee, wie ich das umsetzen kann, dass der die Datei überspringt, die ich quasi schon offen habe.

Noch als Ergänzung, es befinden sich keine Excel Datein in den Ordnern, die nicht geöffnet werden sollen und die Datein, sollen nicht abhängig vom Namen sondern am besten von deren Index oder wie auch immer man die in einer einem Ordner ansprechen kann außer über den Namen geöffnet werden, da die Namen nicht einheitlich sind und von Ordner zu Ordner variieren.

Ich bedanke mich schonmal bei allen die mir weiterhelfen können oder Tipps auf Lager haben. Falls ich mich irgendwie unklar ausgedrückt haben sollte, bitte fragen, dann erkläre ich nochmal.

VG

:)

Uwi63 · 17. Januar 2018

Hallo,

ich hätte folgende Frage:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was war denn nun eigentlich deine Frage?

Naja, ich würde dein Vorgehen nach folgendem Prinzip umsetzen. teste mal:
Code:

Sub Makro_neu2018()
'
Dim user As String
'Den Computer und Usernamen auslesen um ihn später zu verwenden
user = Environ("COMPUTERNAME") + "/" + Environ("USERNAME")
Dim WB As Workbook
Dim WS As Worksheet

Dim WS_Count As Integer
Dim I As Integer
Dim Dateiname As String
Dim Pfad As String
Dim Typ As String

'WS_Count = ActiveWorkbook.Worksheets.Count 'da jedes WB unterschiedlich viele Blätter haben kann, macht das Zählen hier keinen Sinn!
Pfad = ActiveWorkbook.Path & "\"
'Pfad bestimmen
Typ = "*.xlsx"
'Dateityp bestimmen, der Datein die geöffnet werden sollen
Dateiname = Dir(Pfad & Typ)
'Alle Datein des angebenen Typs einlesen
MsgBox Pfad
'Kontrollausgabe während der Programmierung, ob der Pfad stimmt
Do While Dateiname ""
If Not ThisWorkbook.Name = Dateiname Then
Workbooks.Open (Pfad & Dateiname)
Set WB = ActiveWorkbook
Debug.Print WB.Name
For Each WS In WB.Sheets

With WS.PageSetup
'dein Code zum Seite Einrichten
'...
End With
Debug.Print WS.Name

Next WS
MsgBox "Es wurden " & WB.Sheets.Count & " Blätter angepasst", vbInformation
WB.Close True
End If
'nächste Datei lesen
Dateiname = Dir()
Loop
Set WB = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: mit VBA alle xlsx Datein nacheinander öffnen und ein Makro ausführen

mit VBA alle xlsx Datein nacheinander öffnen und ein Makro ausführen

mit VBA alle xlsx Datein nacheinander öffnen und ein Makro ausführen

mit VBA alle xlsx Datein nacheinander öffnen und ein Makro ausführen - Similar Threads - VBA xlsx Datein

VBA in einer Zeile zu lang

Listbox wird nicht breiter, Schriftgrösse ändert sich

VBA makro Umwandlung von XLS zu XLSX

VBA: xlsm als xlsx speichern

VBA, Speichern unter xlsx und pdf

VBA: XLSX-Dateien in verschiedene Tabellenblätter in einer XLXS-Datei zusammenführen

mit VBA .xlsx Datei schließen