Druckbereich per Makro als PDF speichern

Question

Hallo Zusammen,

ich würde gerne den folgenden Code so modifiziert haben das er anstelle von "ActiveSheet.Range("A1:Q20")" den hinterlegten Druckbereich des Tabellenblattes als PDF abspeichert.

Sub speichern_unter_PDF()

Dim sPath As String
sPath = ThisWorkbook.Path 'ANPASSEN
If sPath = "" Then
MsgBox "Die Datei muß zuerst gespeichert werden"
Exit Sub
End If
sPath = IIf(Right$(sPath, 1) = Application.PathSeparator, sPath, sPath & Application. _
PathSeparator)

Dim rng As Range
Set rng = ActiveSheet.Range("A1:Q20") 'ANPASSEN

On Error GoTo ENDE:
Application.DisplayAlerts = False
Dim PDF_NAME As String
PDF_NAME = sPath & "Export vom " & Format(Date, "dd.mm.yyyy") & ".pdf" 'ANPASSEN

If Not PDF_NAME = "Falsch" Then
rng.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDF_NAME, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If

ENDE:
Application.DisplayAlerts = True

End Sub



Kann mir jemand helfen?

Wäre super ...

Answer 1

Hallo,

wenn der Druckbereich festgelegt ist, kannst du das Blatt ganz normal ausdrucken:

Sub speichern_unter_PDF1()
'Druckbereich ist bereits festgelegt

Dim sPath As String
Dim PDF_NAME As String

sPath = ThisWorkbook.Path 'ANPASSEN
If sPath = "" Then
MsgBox "Die Datei muß zuerst gespeichert werden"
Exit Sub
End If

sPath = IIf(Right$(sPath, 1) = Application.PathSeparator, sPath, sPath & Application. _
PathSeparator)

On Error GoTo ENDE:
Application.DisplayAlerts = False

PDF_NAME = sPath & "Export vom " & Format(Date, "dd.mm.yyyy") & ".pdf" 'ANPASSEN

If Not PDF_NAME = "Falsch" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_NAME, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If

ENDE:
Application.DisplayAlerts = True

End Sub

Falls entsprechend deinem anderem Thread nur der markierte Bereich ausgedruckt werden soll, dann probier mal das folgende Makro:

Sub speichern_unter_PDF2()
'markierte Zellen als PDF ausdrucken

Dim sPath As String
Dim PDF_NAME As String

sPath = ThisWorkbook.Path 'ANPASSEN
If sPath = "" Then
MsgBox "Die Datei muß zuerst gespeichert werden"
Exit Sub
End If

sPath = IIf(Right$(sPath, 1) = Application.PathSeparator, sPath, sPath & Application. _
PathSeparator)

'Druckbereich festlegen
ActiveSheet.PageSetup.PrintArea = Selection.Address

On Error GoTo ENDE:
Application.DisplayAlerts = False

PDF_NAME = sPath & "Export vom " & Format(Date, "dd.mm.yyyy") & ".pdf" 'ANPASSEN

If Not PDF_NAME = "Falsch" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_NAME, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If

'Druckbreich aufheben
ActiveSheet.PageSetup.PrintArea = ""

ENDE:
Application.DisplayAlerts = True

End Sub

Gruß

M.O.

Answer 2

Super, das habe ich gesucht ...

DANKE