PDF zusammengefasst speichern

Sub PDFErstellenundSpeichern() Dim Partnernummer As Integer Dim NächstePartnernummer As Integer With Tabelle1 For Partnernummer = 50 To .Cells(.Rows.Count, 1).End(xlUp).Row .Range("B2") = .Cells(Partnernummer, 1) Application.DisplayAlerts = False Application.ScreenUpdating = False Tabelle8.Copy ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:="W:\N M\Monatsabschluß\PDF's - aktuell" & "\Report_" & Range("J4") & "_" & Range("J2") _ _ & "_" & Range("AB2") & ".pdf" ActiveWorkbook.Close Application.DisplayAlerts = True Application.ScreenUpdating = True Next Partnernummer End With MsgBox "Die PDF-Dateien wurden erfolgreich erstellt!", , "PDF-Export" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ich hab da was passendes. Müsstest du aber etwas anpassen, weil ich es einfach aus dem Zusammenhang gerissen habe.
Ich hoffe, das hilft.

Sub Diagramme_PDF_erzeugen_Alle(Zeichen As String, Quellblatt As String, Q As String, Monat As  _
String, nachDATE As String)
AktivesMakro_o = AktivesMakro
AktivesMakro = "Diagramme_PDF_erzeugen_Alle"
' -----  Makro von Klexy, November 2019 ---------------------------------------------
' --- Info --------------------------------------------------------------------------------
' Dieses Makro selektiert alle Tabellenblätter deren Namen mit dem "Zeichen" beginnen
' (Diagrammblätter) und speichert sie als PDF im selben Ordner wie die Excel-Datei
' Es wird automatisiert ein Dateiname vergeben:
' Excel-Name (ggf. + Sparte) + Auswertungsmonat + Art und Datengrundlage der Auswertung
Dim sh As Worksheet, BlätterAnzahl As Long, BlätterNamen() As String, PDF_mit_Pfad As String,  _
aktLOB As String
BlätterAnzahl = -1
PDF_mit_Pfad = ActiveWorkbook.Path & "\" & "Reporting_" & Format(Range("DispoDatenStand"), " _
yyyy-mm-dd") & _
"_für" & "_" & Monat & Q & "_nach_" & nachDATE & ".pdf"
' Array der zu markierenden Blätter bilden:
For Each sh In ActiveWorkbook.Sheets
If Left(sh.Name, 1) = Zeichen Then
BlätterAnzahl = BlätterAnzahl + 1
ReDim Preserve BlätterNamen(BlätterAnzahl)
BlätterNamen(BlätterAnzahl) = sh.Name
End If
Next sh
Sheets(BlätterNamen()).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_mit_Pfad, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False,  _
OpenAfterPublish:=False
Sheets(Quellblatt).Select
AktivesMakro = AktivesMakro_o
End Sub

Public Sub PDFErstellenundSpeichern() Dim Partnernummer As Long Dim objWorkbook As Workbook With Application .ScreenUpdating = False .DisplayAlerts = False End With Set objWorkbook = Workbooks.Add(Template:=xlWBATWorksheet) With Tabelle1 For Partnernummer = 50 To .Cells(.Rows.Count, 1).End(xlUp).Row .Range("B2").Value = .Cells(Partnernummer, 1).Value Call Tabelle8.Copy(After:=objWorkbook.Worksheets(objWorkbook.Worksheets.Count)) Next Partnernummer End With objWorkbook.Worksheets(1).Delete objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:="W:\N M\Monatsabschluß\PDF's - aktuell" & "\Report_" & _ Range("J4").Value & "_" & Range("J2").Value & "_" & Range("AB2").Value & ".pdf" Call objWorkbook.Close(SaveChanges:=False) With Application .ScreenUpdating = True .DisplayAlerts = True End With Call MsgBox("Die PDF-Dateien wurden erfolgreich erstellt!", vbInformation, "PDF-Export") End Sub

Option Explicit Public Sub PDFErstellenundSpeichern() Dim Partnernummer As Long Dim objWorkbook As Workbook Dim objName As Name With Application .ScreenUpdating = False .DisplayAlerts = False End With Set objWorkbook = Workbooks.Add(Template:=xlWBATWorksheet) With Tabelle1 For Partnernummer = 50 To .Cells(.Rows.Count, 1).End(xlUp).Row Tabelle8.Range("B2").Value = .Cells(Partnernummer, 1).Value Call Tabelle8.Copy(After:=objWorkbook.Worksheets(objWorkbook.Worksheets.Count)) For Each objName In objWorkbook.Names Call objName.Delete Next Next Partnernummer End With objWorkbook.Worksheets(1).Delete objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:="W:\N M\Monatsabschluß\PDF's - aktuell" & "\Report_" & _ Range("J4").Value & "_" & Range("J2").Value & "_" & Range("AB2").Value & ".pdf" Call objWorkbook.Close(SaveChanges:=False) With Application .ScreenUpdating = True .DisplayAlerts = True End With Call MsgBox("Die PDF-Dateien wurden erfolgreich erstellt!", vbInformation, "PDF-Export") End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread