PDF Export aus Excel Blatt
10.01.2021 13:57:56
Martin
ich möchte gerne ein Tabellenblatt als pdf speichern. Dazu habe ich schon einiges an Code geschrieben bzw. mir Hilfe über den Makrorekorder verschafft.
Folgendes soll passieren: Sheet1 soll als pdf exportiert werden. Dabei soll der Exportname aus Zelle C1 gespeist werden. Zudem soll die PDF so angepasst werden, dass alle Spalten auf eine Seite passen. Das funktioniert nun auch gewissermaßen, aber ich bekomme 2 Dateien: eine mit dem richtigen Speichernamen, die sich aber nicht öffnen lässt und eine Mappe1, die funktioniert und auch das Format angepasst wurde. Leider sind bei der Makroaufzeichnung so viele Werte entstanden, dass ich nicht wirklich weiß, welche davon überhaupt nötig sind. Und warum ich 2 Dateien bekomme weiß ich auch nicht wirklich...
Über Hilfe wäre ich sehr dankbar!
Sub PDF_save()
Dim pfad As String
Dim datei As String
Dim dateiname As String
Dim Speichername As Variant
datei = ActiveSheet.Range("C1")
dateiname = datei
Speichername = Application.GetSaveAsFilename(dateiname, "PDF-Dateien (*.pdf),*.xlTypePDF")
If Speichername False Then
Worksheets("Sheet1").Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&H&P von &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Worksheets("Sheet1").Copy
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
ActiveSheet.SaveAs Speichername
ActiveWorkbook.Close
Else
MsgBox "Es wurde abgebrochen !"
End If
End Sub
Danke und Gruß,
Martin