Automatisches speichern als pdf

Hallo liebes Forum.
Wir organisieren momentan unsere im Januar stattfindenden ehrenamtlichen Skikurse. Hierzu habe ich eine Excel-Liste für die Anmeldungen erstellt mit verschiedenen Arbeitsblättern, wobei ich freundlicherweise bei einem Teil schon hier im Forum eine Hilfeleistung bekommen habe. Im Arbeitsblatt "Kursbestätigungen" gibt es in der Zelle F12 die Möglichkeit, die in den Stammdaten gespeicherten Teilnehmernummern einzutippen. Es werden dann aus dem Tabellenblatt "Stammdaten" die gewünschten Daten angezeigt. Soweit so gut. Ziel wäre es nun, dieses Tabellenblatt "Kursbestätigung" als pdf im Format DIN A4 abzuspeichern, was prinzipiell ja nicht schwer ist. Was ich allerdings gerne hätte, wäre folgendes:
Da es in Summe bestimmt ca. 100 Teilnehmer sind, will ich nicht für jede Teilnehmernummer das entsprechende Blatt manuell abspeichern. Wunsch wäre, dass per Makro-Knopfdruck folgendes passiert:
Nacheinander sollen die TN-Nr. 1 bis X automatisch unter jeweils folgendem Namen als pdf in einem Ordner nach Wahl gespeichert werden:
Max Mustermann_Bs.pdf
(Inhalt Zelle F21)_(Inhalt Zelle F22).pdf
Würde so etwas gehen? Anbei mal die Datei...
https://www.herber.de/bbs/user/149470.xlsx
Freue mich über Antworten :-)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Kopiere dies in ein Allgemeines Codemodul.


Sub Makro1()
' Makro1 Makro
Dim sName As String
Dim lPreis As Long
Dim sDateiname As String
Dim i As Long
Dim sPfad
Dim letzteTNNr As Integer
Application.ScreenUpdating = False
With Worksheets("Kursbestätigung")
sPfad = Ordnerauswahl
If sPfad  "" Then
letzteTNNr = Application.InputBox("TeilnehmerNr:", "Drucke bis Nr ?", "100", Type:=1)
If Not IsNumeric(letzteTNNr) Then Exit Sub
For i = 1 To letzteTNNr
.Range("F12").Value = i
sDateiname = sPfad
sDateiname = sDateiname & Range("F21").Value
sDateiname = sDateiname & "_"
sDateiname = sDateiname & Range("F22").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sDateiname, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next
MsgBox "Dateien erstellt"
End If
End With
Application.ScreenUpdating = True
End Sub
Public Function Ordnerauswahl() As String
Dim strOrdner As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1)  "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
Ordnerauswahl = strOrdner   '= "" 'Then MsgBox ("Kein Ordner gewählt!") Else MsgBox strOrdner
End Function

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Automatisches speichern als pdf

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread