Alle Sheets d. xls-Dateien ebest. Pfades drucke

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DateinamenAuflisten() Dim Dateiname As String, i As Integer Dateiname = Dir$("c:\test\*.xls") Do While Dateiname <> "" Workbooks.Open "c:\test\" & Dateiname, False For Each cb In ActiveWorkbook.Worksheets cb.Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Next ActiveWorkbook.Close False Dateiname = Dir$() Loop End Sub

Sub DateinamenAuflisten() Dim Dateiname As String, cb As Worksheet Dateiname = Dir$("c:\test\*.xls") Do While Dateiname <> "" Workbooks.Open "c:\test\" & Dateiname, False For Each cb In ActiveWorkbook.Worksheets If cb.Visible = xlSheetVisible Then cb.Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Else 'do nothing oder leg halt fest was passieren soll End If Next ActiveWorkbook.Close False Dateiname = Dir$() Loop End Sub

Hallo Peter,
hierfür gibt es im Drucken-Dialogfenster die Auswahlmöglichkeit "Gesamte Arbeitsmappe". Der gesamte Code, inkl. Sicherheitsabfrage ob die Datei mit gleichem Namen geöffnet werden soll, schaut dann etwa so aus. Beachte bitte, dass dann die Seiten ggf. fortlaufend über alle Blätter nummeriert werden.
Gruss
Franz


Sub Dateien_Mappe_Drucken()
'Druckt die gesamte Arbeitsmappe in den Dateien gemäß Pfad- und Filtereinstellung
'Alle Tabellen werden dabei wenn Seitenzahlen in Kopf- bzw. Fußzeile eingerichtet sind
'mit fortlaufenden Seitennummern gedruckt wenn für die Blätter unter Seite einrichten
'"erste Seitenzahl" auf "Automatisch" eingestellt ist
Dim wb As Workbook, Dateiname As String
Dim Pfad As String, Filter As String, ThisFile
ThisFile = ThisWorkbook.Name
Pfad = "c:\test\values"
Filter = "*.xls"
Dateiname = Dir$(Pfad & "\" & Filter)
Do While Dateiname <> ""
'Prüfung ob Dateiname = Name der Datei ist in der dieses Makro gespeichert ist.
If Dateiname = ThisFile Then
If Pfad = ThisWorkbook.Path Then
Set wb = ThisWorkbook
Else
MsgBox "Die zu druckende Datei im Verzeichnis " & vbLf & vbLf _
& Pfad & vbLf & vbLf & "hat den gleichen Namen wie diese Datei!" _
& vbLf & vbLf & "Die Datei kann nicht gedruckt werden!"
End If
Else
Set wb = Workbooks.Open(Pfad & "\" & Dateiname, False)
End If
'Datei drucken
wb.PrintOut Copies:=1, Collate:=True
If wb.Name <> ThisFile Then
wb.Close savechanges:=False
End If
Dateiname = Dir$()
Loop
End Sub

Beliebteste Forumthreads (12 Monate)

Alle Sheets d. xls-Dateien ebest. Pfades drucke

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread