PDF - Erstellung (Autodesk/Inventor)

Guten Morgen,

hab ein Makro geschrieben welches automatisch einen Ordner im Projektordner erstellt und dann die Inventor-Zeichnung (.idw) in diesen Ordner als PDF abspeichert. Bei mir funktioniert es einwandfrei, jedoch habe ich das Makro an unsere Tochterfirma weitergegeben und bei denen funktioniert es nicht, was kann da das Problem sein?

Hier noch der Code:

Code:
Public Sub PDF()
On Error Resume Next
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
Exit Sub
End If

Dim Pfad As String
Pfad = CurDir & "\"
If Dir(Pfad & "PDF", vbDirectory) = "PDF" Then
'MsgBox "Ordner ''PDF'' ist vorhanden!"
GoTo Sprung
Else
MkDir "PDF"
'MsgBox "Ordner ''PDF'' wurde in folgendem Pfad angelegt: " & Pfad
End If
Sprung:

Dim oDoc As Inventor.DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oFileName As String
oFileName = oDoc.FullDocumentName

Dim oArray() As String
oArray = Split(oFileName, "\")

If oDoc.FullFileName = "" Then
MsgBox "Bitte zuerst die Zeichnung speichern... "
Exit Sub
End If

Dim sName As String
Dim i As Integer
sName = oArray(LBound(oArray))
For i = 1 To UBound(oArray) - 1
sName = sName & "\" & oArray(i)
Next
sName = sName & "\PDF\" & (oArray(UBound(oArray)))

Dim Msg
On Error Resume Next
Err.Clear
If Err.Number <> 0 Then
Msg = "KeineZeichnung "
MsgBox Msg
End If

oDoc.SheetSettings.SheetColor = ThisApplication.TransientObjects.CreateColor(255, 255, 255)

' 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("Remove_Line_Weights") = 0
'oOptions.Value("Vector_Resolution") = 400
'oOptions.Value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
oDataMedium.FileName = Replace(sName, ".idw", ".pdf")
'Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)

Dim oFarbe As DrawingDocument

Set oFarbe = ThisApplication.ActiveDocument
oFarbe.SheetSettings.SheetColor = ThisApplication.TransientObjects.CreateColor(255, 255, 255)

End Sub

------------------
Greets

Xaigon

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