AW: Du "druckst" in eine Datei! Die benötigt einen Namen
14.11.2025 11:56:55
JoWe
Hallo nochmal,
ich habe Google Gemini diese Aufgabe gestellt:
"Erstelle ein Makro, das den Druckbereich eines Tabellenblattes in ein Pdf-Dokument exportiert und aber zuvor einen Auswahldialog zur Bestimmung des Speicherortes anbietet. Dabei soll der Dateiname jedoch schon anhand eines Eintrages in Zelle A1 der Tabelle1 vorgegeben sein."
Hier das Ergebnis mit dem Du evtl. weiter kommst:
Sub DruckbereichAlsPDFSpeichern()
' Deklaration der Variablen
Dim ws As Worksheet
Dim DateinameVorschlag As String
Dim Dateipfad As Variant
' Setzen des Tabellenblattes, aus dem der Dateiname gelesen werden soll.
' ACHTUNG: "Tabelle1" ist der Standard-VBA-Name für das erste Blatt in der Arbeitsmappe.
' Verwenden Sie diesen Namen (nicht den Anzeigenamen in den Tabs!).
On Error Resume Next
Set ws = ThisWorkbook.Sheets("Tabelle1")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Das Tabellenblatt mit dem VBA-Namen 'Tabelle1' wurde nicht gefunden. Das Makro wird beendet.", vbCritical
Exit Sub
End If
' Auslesen des vorgeschlagenen Dateinamens aus Zelle A1
' Unerlaubte Zeichen für Dateinamen werden entfernt und durch einen Unterstrich ersetzt.
DateinameVorschlag = ws.Range("A1").Value
DateinameVorschlag = Replace(DateinameVorschlag, "/", "_")
DateinameVorschlag = Replace(DateinameVorschlag, "\", "_")
DateinameVorschlag = Replace(DateinameVorschlag, ":", "_")
DateinameVorschlag = Replace(DateinameVorschlag, "*", "_")
DateinameVorschlag = Replace(DateinameVorschlag, "?", "_")
DateinameVorschlag = Replace(DateinameVorschlag, Chr(34), "_") ' Anführungszeichen (")
DateinameVorschlag = Replace(DateinameVorschlag, "", "_")
DateinameVorschlag = Replace(DateinameVorschlag, ">", "_")
DateinameVorschlag = Replace(DateinameVorschlag, "|", "_")
' Sicherstellen, dass der vorgeschlagene Dateiname nicht leer ist
If Trim(DateinameVorschlag) = "" Then
DateinameVorschlag = "Exportiertes_PDF"
End If
' Hinzufügen der Dateiendung ".pdf"
If Right(LCase(DateinameVorschlag), 4) > ".pdf" Then
DateinameVorschlag = DateinameVorschlag & ".pdf"
End If
' === 1. Speicherort-Dialog anzeigen und Pfad ermitteln ===
' Erstellung eines Dateidialog-Objekts (msoFileDialogSaveAs)
With Application.FileDialog(msoFileDialogSaveAs)
.InitialFileName = DateinameVorschlag
.Title = "PDF speichern unter..."
' Filter, um nur PDF als Dateityp zu ermöglichen
.Filters.Clear
.Filters.Add "PDF-Dateien", "*.pdf"
' Zeigt den Dialog an und prüft, ob der Benutzer auf "Speichern" klickt (True)
If .Show = True Then
Dateipfad = .SelectedItems(1)
Else
' Benutzer hat den Dialog abgebrochen
MsgBox "Der Export wurde abgebrochen.", vbInformation
Exit Sub
End If
End With
' === 2. Druckbereich als PDF exportieren ===
' Prüfen, ob für das aktive Blatt ein Druckbereich festgelegt ist
If ActiveSheet.PageSetup.PrintArea = "" Then
MsgBox "Kein Druckbereich auf dem aktiven Tabellenblatt festgelegt. Der gesamte Inhalt wird exportiert.", vbExclamation
End If
' Exportieren des aktuell ausgewählten Druckbereichs (oder des gesamten Blattes, falls keiner definiert)
' als PDF-Datei zum ermittelten Pfad
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Dateipfad, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True ' Öffnet das PDF nach dem Speichern (kann auf False gesetzt werden)
MsgBox "Der Druckbereich von '" & ActiveSheet.Name & "' wurde erfolgreich unter '" & Dateipfad & "' gespeichert.", vbInformation
End Sub
Gruß
Jochen