---

Hallo, Forum,

um den "langen" Weg über das Druck-Menü zu sparen, habe ich ein Makro in Verwendung, das mir meine Zeichnungen direkt im richtigen Format in ein PDF-Dokument druckt.

Hier das Makro:

Code:

---

Public Sub AblagePDF()

    If ThisApplication.Documents.Count = 0 Then
        MsgBox "Es ist kein Dokument geöffnet!", 0, "Fehler"
        Exit Sub
    End If
   
    If ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then
        MsgBox "Das geöffnete Dokument ist keine Zeichnung!", 0, "Fehler"
        Exit Sub
    End If

    Dim oPrintMgr As DrawingPrintManager

    For Each s In ThisApplication.ActiveDocument.Sheets
        s.Activate
        Start_Zeit = Timer
        Do While Timer < Start_Zeit + 1
    Loop
   
    Set oPrintMgr = ThisApplication.ActiveDocument.PrintManager
    oPrintMgr.NumberOfCopies = 1
    oPrintMgr.Printer = "FreePDF XP"
    oPrintMgr.Orientation = kLandscapeOrientation
    oPrintMgr.PaperSize = kPaperSizeCustom
    oPrintMgr.PaperHeight = 297
    oPrintMgr.PaperWidth = 420
    Start_Zeit = Timer
   
    Do While Timer < Start_Zeit + 1
    Loop
   
    ThisApplication.ActiveView.WindowState = kMaximize
    oPrintMgr.SubmitPrint
    Start_Zeit = Timer
   
    Do While Timer < Start_Zeit + 1
    Loop

    Next

End Sub

---

Mein Problem ist nun folgendes:

Der Druckauftrag wird für jedes Blatt einzeln durchlaufen und abgeschickt. Mehrseitige Zeichnungen habe ich bisher über den Button "MultiDoc im erscheinenden Free-PDF-Menü per einfachen Mausklick verbunden.

Nun habe ich aber eine mehrseitige Zeichnung direkt aus Inventor an den Plotter geschickt. Dabei habe ich im Druckermenü die Option "alle Seiten" aktiviert.

Das "färbt" nun ab, so daß mein Makro bei mehrseitigen Zeichnungen wie gewünscht mehrere Druckaufträge startet, die aber nun nicht mehr nur das aktive Blatt enthalten, sondern alle Blätter. Im Endeffekt bekomme ich also ein PDF, das z.B. drei Seiten jeweils dreimal enthält, da für jede Seite das gesamte Dokument gedruckt wird.

Nun möchte ich gerne dem Druckertreiber über das Makro mitteilen, daß er immer eine Seite nach der anderen drucken soll, egal welche Einstellung im Druck-Menü getroffen ist.

Wie kann ich die Option "nur aktive Seite" an den Druckertreiber übergeben?

------------------
Cheers,
    Jochen

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

---

Hallo

Ergänze mal

Code:

---

oPrintMgr.PrintRange=kPrintCurrentSheet

---

------------------
MfG
RK

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

---

Funktioniert!

Danke!

------------------
Cheers,
    Jochen

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

---

Hallo Fyodor,

hast du schon mal die Ausgabe des PDF direkt aus Inventor probiert?
Der Vorteil, der sich hier ergibt, alle Seiten in einem PDF-File.

Seit wir die 64-Bit Version von Inventor nutzen, gibt es auch keine Probleme mehr, mit nicht angezeigten Linien.

Ich habe den Code aus den Beispielen für uns angepasst.

Grüße

Peter

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

---

Was meinst Du mit direkt aus Inventor?

------------------
Cheers,
    Jochen

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

---

Hallo,

die Funktion, die du bei einer IDW hast, bei Kopie speichern unter
> Dateityp > PDF

Bei mir sieht das so aus,
vielleicht kannst du es ja brauchen.

Peter

EDIT: Ich habe nur die Code-Zeilen nochmal ausgedünnt, und alles was bei uns
spezifisch war rausgeschmissen.

Public Sub PDFActivSheetdirect()
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    Set PDFAddIn = _
    ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument

    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism

    ' Create a NameValueMap object
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then

        ' Options for drawings...
       
        'oOptions.Value("All_Color_AS_Black") = 0
        'oOptions.Value("All_Color_AS_Black") = 1

       
        'oOptions.Value("All_Color_AS_Black") = 0
        'oOptions.Value("Remove_Line_Weights") = 1
       
        'oOptions.Value("Sheet_Range") = kPrintAllSheets
        'oOptions.Value("Sheet_Range") = kPrintCurrentSheet
        'oOptions.Value("Vector_Resolution") = 1
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4

    End If

    'Set the destination file name
    oDataMedium.FileName = "c:\PDF_FILENAME.pdf"

    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) 
   
End Sub

[Diese Nachricht wurde von pd65 am 19. Mrz. 2010 editiert.]

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

---

Die Inventor-PDF hat noch den Vorteil, dass sie "feiner" ist. Mit FreePDF hatten wir trotz höchster DPI-Einstellung Probleme bei der Kombination 1:50 und kleine Gewindebohrungen, die Bohrungen sind nur noch Kleckse. Mit Inventor->PDF ist das ganze wieder erkennbar.

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

---

Hallo VBA Profis,

hat jemand einen TIP wie ich das Dokument mit dem Dateinamen von Inventor abspeichern kann ?
mit ActiveDocument.Name komme ich nicht so richtig weiter.

thx für die Hilfe und ein schönes Wochenende

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

---

Hallo

Hier mal ein Teil von meine Code:

'Check number of Pages
    Dim NumPages As Integer
    NumPages = dDoc.Sheets.Count
   
    Dim s As Integer
    s = 1
   
    Dim byWert As Byte
   
    'Sheet Number 1
    If NumPages > 1 Then
       
        ' Create File Name and Path
        If Len(Trim(dDoc.FullFileName)) > 0 Then
            outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.FullFileName) & " Blatt 1" & ".pdf"
            'Set Activ Sheet to Sheet Number s
            dDoc.Sheets(s).Activate
            'Set Options
            oOptions.Value("Custom_Begin_Sheet") = s
            oOptions.Value("Custom_End_Sheet") = s
            'Set the destination file name
            oDataMedium.FileName = outFile
            'Publish document
            If fso.fileexists(outFile) Then
                'MsgBox "Datei existiert bereits, bitte löschen oder Zeichnung umbenennen!", vbInformation, "...."
                byWert = MsgBox("Datei existiert bereits, Datei überschreiben?", vbYesNo, "....")
                If byWert = 6 Then
                    Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
                Else
                    MsgBox "Datei wurde nicht überschrieben!", vbInformation, "...."
                End If
            Else
                Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
            End If
        Else
            MsgBox "Bitte zuerst das IDW Speichern!", vbInformation, "...Toni..."
        End If

--NACHTRAG--
Damit kann das PDF auch gleich noch geöffnet werden.

'PDF erstellen
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
'PDF Öffnen
Call Shell(strProg & " " & outFile, vbMaximizedFocus)

--THE END--

Hoffe das Hilft dir.
Wenn du mehr benötigst PM

------------------
Grüsse, Toni

Rechtschreibefehler gehören dem findigen Finder

[Diese Nachricht wurde von RODER am 23. Aug. 2011 editiert.]

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

---

Hallo VB Gemeinde,

Das PDF erstellung‘s Marco geht einwandfrei *danke an den supporter  *
Nun würde ich die PDF’s nach der Erstellung noch gerne anzeigen lassen, und zwar mit dem hinterlegten Windows Standardanzeigeprogramm

auf

  strProg = "C:\Program Files (x86)\Adobe\Reader 9.0\Reader\acroRd32.exe"
  strFile = "c:\ABC123\" & fso.GetBaseName(dDoc.FullFileName) & ".pdf"
  Call Shell(strProg & " " & strFile, vbMaximizedFocus)

Bin ich schon gestoßen aber es hat jeder etwas anderes woanders Installiert und eine suche nach der acroRd32.exe  geht mir zulange.

Ich hoffe es gibt eine Lösung
Viele grüße

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

---

Code:

---

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Sub main()

        strFile = "C:\Users\Public\Documents\www.inventor-tools.de\Hilfe\Administrator.pdf"
       
        Call ShellExecute(GetDesktopWindow(), "Open", strFile, "", "C:\", 1)
End Sub

---

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