| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | PNY WIRD VON NVIDIA ZUM HÄNDLER DES JAHRES GEWÄHLT, eine Pressemitteilung
|
Autor
|
Thema: Makro: Pdf mit Blattnummern-Angabe (534 / mal gelesen)
|
Starbuzz Mitglied
Beiträge: 63 Registriert: 14.11.2014
|
erstellt am: 08. Jan. 2020 11:51 <-- editieren / zitieren --> Unities abgeben:
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 |
Meierjo Mitglied
Beiträge: 416 Registriert: 20.08.2003 Windows 10 Prof 64 Bit Inventor Prof 2021 Vault Basic 2021
|
erstellt am: 08. Jan. 2020 13:07 <-- editieren / zitieren --> Unities abgeben: Nur für Starbuzz
|
bkrüger Mitglied Konstrukteur
Beiträge: 51 Registriert: 14.09.2014 Win10 IV2018 Vault2018-WG
|
erstellt am: 08. Jan. 2020 13:59 <-- editieren / zitieren --> Unities abgeben: Nur für Starbuzz
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 seinDim 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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|