Bonjour,
Bienvenu sur le forum 
ci-joint une macro existante
CitationSub ShowAllOpenFiles()
Dim swDoc As SldWorks.ModelDoc2
Dim swAllDocs As EnumDocuments2
Dim FirstDoc As SldWorks.ModelDoc2
Dim dummy As Boolean
Dim NumDocsReturned As Long
Dim DocCount As Long
Dim i As Long
Dim sMsg As String
Dim swApp As SldWorks.SldWorks
Dim bDocWasVisible As Boolean
Dim OpenWarnings As Long
Dim OpenErrors As Long
Dim DwgPath As String
Dim myDwgDoc As SldWorks.ModelDoc2
Dim drwPathName As String
Dim pdfPathName As String
Dim pdfFolderName As String
Dim swExportPDFData As SldWorks.ExportPdfData
Dim lErrors As Long
Dim lWarnings As Long
Dim boolstatus As Boolean
Set swApp = Application.SldWorks
Set swAllDocs = swApp.EnumDocuments2
Set FirstDoc = swApp.ActiveDoc
DocCount = 0
swAllDocs.Reset
swAllDocs.Next 1, swDoc, NumDocsReturned
While NumDocsReturned <> 0
bDocWasVisible = swDoc.Visible
‹ swApp.ActivateDoc swDoc.GetPathName ›
DwgPath = swDoc.GetPathName
If (LCase(Right(DwgPath, 3)) <> « drw ») And (DwgPath <> « ») Then
DwgPath = Left(DwgPath, Len(DwgPath) - 3) & « drw »
Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, « », OpenErrors, OpenWarnings)
If Not myDwgDoc Is Nothing Then
swApp.ActivateDoc myDwgDoc.GetPathName
pdfFolderName = "C:\pdf files"
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject(« Scripting.FileSystemObject »)
If (Not fso.FolderExists(pdfFolderName)) Then
MkDir pdfFolderName
'MsgBox (pdfFolderName + " does not exist")
'Exit Sub
End If
Dim Part As ModelDoc2
Set Part = swApp.ActiveDoc()
'You have a drawing active
drwPathName = Part.GetPathName()
If (« » = drwPathName) Then
’ GetPathName() was empty
MsgBox (« This drawing has not been saved yet »)
Exit Sub
End If
pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + « .pdf »)
Debug.Print pdfPathName
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False
Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
'MsgBox (« PDF file was created »)
swApp.QuitDoc (Part.GetTitle)
Set myDwgDoc = Nothing
End If
End If
swAllDocs.Next 1, swDoc, NumDocsReturned
DocCount = DocCount + 1
Wend
swApp.ActivateDoc FirstDoc.GetPathName
End Sub
pdf_des_composants_de_lassemblage.swp (54 Ko)
0