Dateien öffnen und best. Blatt drucken
05.03.2021 14:17:14
Davidina11
folgende Ausgangssituation:
Ich habe einen Ordner "Wartungspläne" mit diversen Unterordnern, diese enthalten sämtliche Wartungspläne (ca. 150 Stück) verschiedener Geräte im Excel-Format. Jede dieser Dateien ist gleich aufgebaut und hat verschiedene Tabellenblätter beschriftet mit den einzelnen Monaten ("Januar", "Februar", ...). Auf diesen Tabellenblättern sind die verschiedenen Wartungsaufgaben aufgelistet.
Mein Ziel ist es alle Wartungspläne automatisiert per VBA ausdrucken zu können. Dafür möchte ich in Excel nur einen Monat ("April") auswählen (z.B. über einen Button oder eine ListBox) und danach werden alle Tabellenblätter mit diesem Namen aus den verschiedenen Dateien innerhalb der Unterverzeichnisse ausgedruckt. Die entsprechenden Exceldateien sollten automatisch geöffnet, gedruckt und wieder geschlossen werden
Bisher wird das per Hand gemacht und das dauert ziemlich laaaaaaaaange.
Ich habe mir hier heute verschiedene Codes zusammengesucht und ausprobiert. Aber ich bin nur stückchenweise voran gekommen.
Meine Fragen:
1. Wie kann ich auch die Unterordner durchlaufen?
2. Wie kann ich das Makro per Button oder ListBox aufrufen und dabei den Monat (z.B. April)als Paramenter übergeben?
Folgenden Code habe ich bisher.
Schöne Grüße,
Davidina11
Public Sub WartungsplanDrucken(strMonat As String)
Dim strFileName As String
Dim strPath As String
On Error GoTo Fin
' beispielhaft mit 1 Unterordner
strPath = ThisWorkbook.Path & "\Unterordner1\"
If Right(strPath, 1) "\" Then strPath = strPath & "\"
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
strFileName = Dir$(strPath & "*.xls*")
Do While strFileName ""
If Not strFileName = ThisWorkbook.Name Then
Workbooks.Open strPath & strFileName
With ActiveWorkbook
.Worksheets(strMonat).PrintOut
.Close False
End With
End If
strFileName = Dir$()
Loop
Fin:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub