Excel pro ID als PDF speichern über Makro

Hallo
Ich bin zwar in Sachen Excel-Formeln versiert, in Bezug auf Makro/VBA leider aber ein Amateur, weshalb ich für folgende Herausforderung Hilfe suche:
Ich habe ein Excel (Excel 2016) mit 10 Registern:
1) Liste
2) Filter
3) Cockpit
4-10) Daten1-7
1) Liste
Enthält eine komplette Liste aller Standorte (IDs) in Spalte A:A.
2) Filter
Enthält eine Liste ausgewählter Standorte in Spalte A:A (wird manuell definiert).
3) Cockpit
Enthält Daten und Visualisierungen zu einem Standort (2 Seiten).
Die Daten dazu werden aus den Registern Daten1-Daten7 mittels Formeln zusammengetragen.
Die Auswahl erfolgt über einen Filter (über Daten, Datenüberprüfung, Zulassen=Liste) in Zelle C2. Ausgewählt werden können alle Standorte gemäss Tabellenblatt "Liste"
Makro (Wunschvorstellung)
Das Makro sollte jeden Standort aus dem Register "Filter" im Register "Cockpit" auswählen und das Cockpit als PDF abspeichern, wobei folgende Schritte abgespult werden sollten:
Unter dem Pfad C:\Beispiel einen Ordner mit dem aktuellen Datum als Namen erstellen (dieser Schritt ist optional, kann auch manuell erstellt werden).
In diesem Ordner das Cockpit speichern.
Der Name des PDFs ergibt sich aus der Formel «=M2&"_"&C5&"_"&C2» (gemäss der aktuellen Ansicht im Register "Cockpit".
Das ganze wiederholen bis Liste im Register "Filter" abgearbeitet ist.
Für jede Hilfe bin ich dankbar und wünsche einen schönen Tag.
Liebe Grüsse,
Reto

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long Sub savePDFs() Dim strPath As String, strFile As String Dim varID As Variant, varItem As Variant Dim lngLast As Long Const conSAVEPATH As String = "C:\Beispiel" strPath = conSAVEPATH & IIf(Right(conSAVEPATH, 1) = "\", "", "\") & Format(Date, "YYYYMMDD") & "\" If MakeSureDirectoryPathExists(strPath) = 1 Then With Sheets("Filter") lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row) If lngLast > 2 Then varID = .Range("A2:A" & lngLast) Else Redim varID(1 To 1, 1 To 1) varID(1, 1) = .Range("A2") End If End With With Sheets("Cockpit") For Each varItem In varID .Range("C2") = varItem .Calculate Call .ExportAsFixedFormat(xlTypePDF, strPath & varItem & ".pdf", IgnorePrintareas:=False, OpenAfterPublish:=False) Next .Range("C2") = varID(1, 1) End With Else Call MsgBox("Das Verzeichnis" & vbLf & strPath & vbLf & "konnte nicht erstellt werden!", vbExclamation) End If End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Lieber Sepp
Erst einmal: Tausend Dank, das ist ja super. Das Makro funktioniert einwandfrei. Ich habe nur noch die Namensgebung für die einzelnen PDFs angepasst (Name des PDFs ergibt sich aus der Formel «=M2&"_"&C5&"_"&C2» gemäss der aktuellen Ansicht im Register "Cockpit"), was ich anhand deines Codes auch ohne VBA-Kenntnisse problemlos hingekriegt habe: Ich danke dir vielmals!
Hier noch mein definitiver Code:

Option Explicit
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath  _
As String) As Long
Sub savePDFs()
Dim strPath As String, strFile As String
Dim varID As Variant, varItem As Variant, VarKT As Variant, VarBETR As Variant
Dim lngLast As Long
Const conSAVEPATH As String = "Q:\...[Hier Speicherpfad eingeben]"
strPath = conSAVEPATH & IIf(Right(conSAVEPATH, 1) = "\", "", "\") & Format(Date, "YYYYMMDD") & _
If MakeSureDirectoryPathExists(strPath) = 1 Then
With Sheets("Filter")
lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
If lngLast > 2 Then
varID = .Range("A2:A" & lngLast)
Else
ReDim varID(1 To 1, 1 To 1)
varID(1, 1) = .Range("A2")
End If
End With
With Sheets("Cockpit")
For Each varItem In varID
.Range("C2") = varItem
VarKT = .Range("M2")
VarBETR = .Range("C5")
.Calculate
Call .ExportAsFixedFormat(xlTypePDF, strPath & VarKT & "_" & VarBETR & "_" & varItem & " _
.pdf", IgnorePrintareas:=False, OpenAfterPublish:=False)
Next
.Range("C2") = varID(1, 1)
End With
Else
Call MsgBox("Das Verzeichnis" & vbLf & strPath & vbLf & "konnte nicht erstellt werden!",  _
vbExclamation)
End If
End Sub

Liebe Grüsse,
Reto

Sub savePDFs() Dim strPath As String, strFile As String, strName As String Dim varID As Variant, varItem As Variant Dim lngLast As Long Const conSAVEPATH As String = "C:\Beispiel" strPath = conSAVEPATH & IIf(Right(conSAVEPATH, 1) = "\", "", "\") & Format(Date, "YYYYMMDD") & "\" If MakeSureDirectoryPathExists(strPath) = 1 Then With Sheets("Filter") lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row) If lngLast > 2 Then varID = .Range("A2:A" & lngLast) Else Redim varID(1 To 1, 1 To 1) varID(1, 1) = .Range("A2") End If End With With Sheets("Cockpit") For Each varItem In varID .Range("C2") = varItem .Calculate strName = .Range("M2") & "_" & .Range("C5") & "_" & varItem & ".pdf" Call .ExportAsFixedFormat(xlTypePDF, strPath & strName, IgnorePrintareas:=False, OpenAfterPublish:=False) Next .Range("C2") = varID(1, 1) End With Else Call MsgBox("Das Verzeichnis" & vbLf & strPath & vbLf & "konnte nicht erstellt werden!", vbExclamation) End If End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Beliebteste Forumthreads (12 Monate)

Excel pro ID als PDF speichern über Makro

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

332 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E	F
1	Gruß Sepp
2
3

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Excel pro ID als PDF speichern über Makro

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

332 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread