AW: Mehrfachdruck mit Umbenennung
19.11.2020 00:55:15
fcs
Hallo Juergen,
grundsätzlich kann man die Ausgabe des Druckbereichs per Makro umsetzen.
Bei der Ausgabe als JPG via Druckertreiber habe ich aber das Problem: Wie kann der Dateiname an das Druckprogramm übergeben werden.
Einfacher wäre Ausgabe als PDF. Das geht mit Excel-Bordmitteln.
LG
Franz
Sub BAB_I_Drucken_als_JPG()
Dim wks As Worksheet
Dim iZaehler As Integer
Dim strPfad As String, strFile As String, strPrintFile As String
Set wks = ActiveSheet
'oder
'Set wks =Activeworkbook.worksheets("BAB I")
If MsgBox("Blatt """ & wks.Name & """ jetzt in einer Schleife für verschiedene Werte " _
& "in G1 drucken?" & vbLf & vbLf _
& "Drucker: " & Application.ActivePrinter, _
vbQuestion + vbOKCancel, "Drucken") = vbCancel Then Exit Sub
strPfad = ActiveWorkbook.Path 'Verzeichns für Druck-Datei - ggf. anpassen
strFile = ActiveWorkbook.Name
strFile = Left(ActiveWorkbook.Name, InStrRev(strFile, ".") - 1) & "-"
With wks
For iZaehler = 1 To 20 'Wenn nicht fix, dann Endwert ggf. aus Zelle einlesen
strPrintFile = strPfad & "\" & strFile & Format(iZaehler, "00") & ".jpg"
.Range("G1") = iZaehler
.Calculate
' hier dann die Anweisungen zum Drucken - Syntax für den JPG-Drucker ?
.PrintOut Preview:=False, printtofile:=True, prtofilename:=strPrintFile
Next
End With
End Sub
Sub BAB_I_Speichern_PDF()
Dim wks As Worksheet
Dim iZaehler As Integer
Dim strPfad As String, strFile As String, strPrintFile As String
Set wks = ActiveSheet
'oder
'Set wks =Activeworkbook.worksheets("BAB I")
If MsgBox("Blatt """ & wks.Name & """ jetzt in einer Schleife für verschiedene Werte in " _
& "G1 als PDF speichern?", _
vbQuestion + vbOKCancel, "Als PDF speichern") = vbCancel Then Exit Sub
strPfad = ActiveWorkbook.Path 'Verzeichns für Druck-Datei - ggf. anpassen
strFile = ActiveWorkbook.Name
strFile = Left(ActiveWorkbook.Name, InStrRev(strFile, ".") - 1) & "-"
With wks
For iZaehler = 1 To 20 'Wenn nicht fix, dann Endwert ggf. aus Zelle einlesen
strPrintFile = strPfad & "\" & strFile & Format(iZaehler, "00") & ".pdf"
.Range("G1") = iZaehler
.Calculate
'Tabellen als PDF speichern
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPrintFile, ignoreprintareas:=False
Next
End With
End Sub