Les bouts de code VBA :
Supprimer les vues RASTER :
Sub RasterViewRemove()
Dim oDrawing As DrawingDocument
Dim oSheet As Sheet
Dim oView As DrawingView
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Set oDrawing = ThisApplication.ActiveDocument
For Each oSheet In oDrawing.Sheets
If oSheet.DrawingViews.Count > 0 Then
For Each oView In oSheet.DrawingViews
oView.IsRasterView = False
Next
End If
Next
End If
End Sub
Export PDF :
Sub ExportPDF(oPath As String, oFileName As String, oDocument As Document, oOptions As NameValueMap)
' Get the PDF translator Add-In.
Dim PDFAddIn As TranslatorAddIn
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a DataMedium object
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
'Set the destination file name
oDataMedium.filename = oPath & oFileName
'Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub
La fonction qui appelle celle d'avant avec le oOptions
Private Sub btnExportPdf_Click()
' Create a NameValueMap object
Dim oOptions As NameValueMap, oDirectory As String, oFileName As String, oFileDialog As Inventor.FileDialog
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oOptions.value("All_Color_AS_Black") = cbBW.value
oOptions.value("Remove_Line_Weights") = cbLineWeights.value
Dim Vector As Integer
Vector = tbResolution.value
oOptions.value("Vector_Resolution") = Vector
If optbtnAllSheets.value Then
oOptions.value("Sheet_Range") = kPrintAllSheets
End If
If optbtnCurrentSheet Then
oOptions.value("Sheet_Range") = kPrintCurrentSheet
End If
If optbtnSheets Then
Dim sFrom As Integer
Dim sTo As Integer
sFrom = tbSheetFrom.value
sTo = tbSheetTo.value
oOptions.value("Sheet_Range") = kPrintSheetRange
oOptions.value("Custom_Begin_Sheet") = sFrom
oOptions.value("Custom_End_Sheet") = sTo
End If
If optbtnDirectoryChoice Then
Set oFileDialog = Nothing
Call ThisApplication.CreateFileDialog(oFileDialog)
oFileDialog.Filter = "Adobe Acrobe PDF files (*.pdf)|*.pdf"
oFileDialog.InitialDirectory = ThisApplication.DesignProjectManager.ActiveDesignProject.WorkspacePath
oFileDialog.CancelError = True
If optbtnCustomFileName Then
oFileDialog.filename = tbCustomFileName.text
Else
oFileDialog.filename = getFileName(ThisApplication.ActiveDocument.FullFileName) & ".pdf"
End If
On Error Resume Next
Call oFileDialog.ShowSave
If err.Number <> 0 Then
Exit Sub
ElseIf oFileDialog.filename = "" Then
MsgBox "Le nom du fichier est vide"
Exit Sub
Else
oFileName = oFileDialog.filename
End If
Else
oDirectory = getPath(ThisApplication.ActiveDocument.FullFileName)
If optbtnCustomFileName Then
oFileName = tbCustomFileName.text & ".pdf"
Else
oFileName = getFileName(ThisApplication.ActiveDocument.FullFileName) & ".pdf"
End If
End If
Call ExportPDF(oDirectory, oFileName, ThisApplication.ActiveDocument, oOptions)
End Sub
Il faut ensuite boucler sur chaque page, personnaliser le nom du fichier de sortie. J'ai des options avec des cases à cocher pour notre application mais il faut juste prendre kPrintCurrentSheet et supprimer le reste pour le choix des pages.
