---

Hallo,

ich habe ein pdf Makro erstellt.
Ich suche aber die Propertie zu <Blattnummer>.
Ziel ist es, das die erzeugte Datei so aufgebaut ist:
Dokumentenname_Blattnummer.pdf

Ich habe es soweit, das der Dokumentname als Speichername genommen wird. Aber die Blattnummer hätte ich ganz gerne mit dabei.

Kann mir bitte einer weiter helfen?

Vielen Dank!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Name = ThisApplication.ActiveDocument.ActiveSheet.Name

Gruss

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,
anbei komplette Sub für Einzelblatt-pdf-Ausgabe,
der pdfname wird aus dem Namen (und Pfad) der idw und
der laufenden Nummer mit Unterstrich getrennt gebildet 
dazu paar Tests und debug-Ausgaben, um nicht in jede Falle zu laufen.
Das "Nicht drucken"-Flag wird beachtet.

Sollte der Blattname als Bestandteil des PDF-Namens verwendet werden, ist

Code:

---

    oDataMedium.FileName = PDFName & "_" & BlattNummer & ".pdf"

---

durch

Code:

---

  oDataMedium.FileName = PDFName & "_" & Replace(odoc.Sheets(BlattNummer).name, ":", "_") & ".pdf"

---

zu ersetzen (Ansonsten ungültiger Dateiname, da sheets().name ein ":" enthält 

Code:

---

Sub PDF_Publish_Einzelblatt() ' Datei geöffnet; muss idw sein

Dim addin_PDFAddIn As TranslatorAddIn
Dim odoc As DrawingDocument
Dim oContext As TranslationContext
Dim ooptions As NameValueMap
Dim oDataMedium As DataMedium
Dim PDFName As String 'Rumpfname ohne erw. und Blattkennzeichnung
Dim BlattNummer As Long 'Aktuelle Blattnummer
Dim Gedruckt As Long ' Zähler der wirklich gedruckten Blätter
'------------------------------------------------------------------------
'Abfangen:
'1. keine Datei offen
If ThisApplication.ActiveDocument Is Nothing Then Exit Sub
'2. Datei offen, aber nicht idw
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub 'nur idw zulassen
Set odoc = ThisApplication.ActiveDocument
'3. idw-Datei jungfräulich -> Datei muss mindestens 1x gespeichert worden sein (ansonsten .fullfilename leer)
If odoc.FileSaveCounter = 0 Then
    MsgBox "Stopp - Datei muss zuerst gespeichert werden", vbOK, "Abbruch"
    Exit Sub
End If
' jetzt kanns los gehen:
'1. Dateiname für PDF vorbereiten (ohne Blattkennung und ohne Endung)
PDFName = odoc.FullFileName  ' PDF Name aus dem idw-Namen bilden
PDFName = Left(PDFName, (InStrRev(PDFName, ".") - 1)) ' Endung ".idw" abschneiden
'----
'2. Setzen der üblichen konstanten (wie in den samples)
Set addin_PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism  ' was immer es auch sei....
Set ooptions = ThisApplication.TransientObjects.CreateNameValueMap ' man müßte mal rausfinden, was eine NameValueMap eigentlich ist...
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
If addin_PDFAddIn.HasSaveCopyAsOptions(odoc, oContext, ooptions) Then
    ooptions.value("All_Color_AS_Black") = 0
    ooptions.value("Remove_Line_Weights") = 0
    ooptions.value("Sheet_Range") = kPrintSheetRange 'für Ausgabe eines bestimmten Seiten-Bereiches
    ooptions.value("Vector_Resolution") = 400
Else
    MsgBox "interner Fehler, Abbruch", vbCritical, "HasSaveCopyAsOptions=false"
    Exit Sub
End If
'----
Debug.Print "Start PDF-Ausgabe: " & odoc.Sheets.Count & " Blätter in der idw zur einzelblatt-PDF-Ausgabe"
Gedruckt = 0
'3. Ausgabeschleife - für jedes Blatt:
For BlattNummer = 1 To odoc.Sheets.Count
    oDataMedium.FileName = PDFName & "_" & BlattNummer & ".pdf" ' PDF-Name zusammensetzen
    ooptions.value("Custom_Begin_Sheet") = BlattNummer
    ooptions.value("Custom_End_Sheet") = BlattNummer
    If Not odoc.Sheets(BlattNummer).ExcludeFromPrinting Then  ' nur drucken, wenn in den Blatteigenschaften entsprechendes Häkchen "nicht drucken" nicht gesetzt
        Call addin_PDFAddIn.SaveCopyAs(odoc, oContext, ooptions, oDataMedium) ' Ausgabe der PDF - Achtung: existierende pdf-Dateien werden kommentarlos überschrieben
        Gedruckt = Gedruckt + 1
        Debug.Print "      Gedruckt: " & oDataMedium.FileName  ' so sieht man wenigstens im Debugfenster etwas
      Else
        Debug.Print "Nicht Gedruckt: " & oDataMedium.FileName
      End If
Next BlattNummer

MsgBox "Es wurden " & Gedruckt & " von " & odoc.Sheets.Count & " Blättern als PDF ausgegeben", vbOK, "Ende" 'Fertsch

End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP