Anzeige
Archiv - Navigation
1344to1348
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

mehrere Dateien mit mehreren Blättern drucken!

mehrere Dateien mit mehreren Blättern drucken!
20.01.2014 14:28:45
Marcus
Hallo muss mehrere (ca200) dateien mit mehreren Blättern drucken. jede datei in eine pdf. wie mach ich das

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: mehrere Dateien mit mehreren Blättern drucken!
20.01.2014 15:26:52
fcs
Hallo Marcus,
hier ein entsprechendes Makro, dass die in einem Dateiauswahl-Dialog gewählten Dateien nacheinander abarbeitet.
Gruß
Franz
'Erstellt unter Excel 2010
'Code in einem allgemeinen Modul
Sub PrintPDFs()
Dim wkb As Workbook
Dim varAuswahl As Variant, varFile
Dim strPDF As String
On Error GoTo Fehler
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.InitialFileName = "*.xls*"
.Title = "Bitte Dateien für PDF-Ausgabe auswählen - Mehrfachauswahl ist möglich"
If .Show = -1 Then
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each varFile In .SelectedItems
Set wkb = Application.Workbooks.Open(Filename:=varFile, ReadOnly:=True)
'PDF-Dateiname - Verzeichnis ggf. anpassen
strPDF = wkb.Path & "\" & Left(wkb.Name, InStrRev(wkb.Name, ".") - 1)
wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDF, _
includedocproperties:=True, Openafterpublish:=False
wkb.Close savechanges:=False
Set wkb = Nothing
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
Application.ScreenUpdating = True
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly + vbInformation, "Makro: AusgabePDF"
If Not wkb Is Nothing Then wkb.Close savechanges:=False
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Select
End With
End Sub

Anzeige

249 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige