Macro enregistrement pdf multi fichier

2D plans
1 
Bonjour,
Nous utilisons une macro pour enregistrer une mise en plan en pdf et dxf, je n'arrive pas à la modifier pour quelle enregistre 2 feuilles (ou plus)
dans un seul fichier pdf
si quelqu'un peut m'aiguiller, merci d'avance
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim swSheet As SldWorks.Sheet
Dim vSheets As Variant
Dim i As Integer
Dim valOut1 As String
Dim valOut2 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim objShell   As Shell
Dim Folder As Object
Dim objFolder  As Folder
Dim objFile As Object
Dim Path As String
Dim nomb1 As String
Dim nomb2 As String
Dim nomb3 As String
Dim lettre As String
Dim Path1 As String
Dim Path2 As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set Part = swApp.ActiveDoc
    Set objShell = New Shell
    
        swPathName = Part.GetPathName
        nomb1 = Len(swPathName)
        nomb2 = InStrRev(swPathName, "\")
        nomb3 = nomb1 - nomb2
        swPath1 = Right(swPathName, nomb3)
        nomb = nomb3 - 7
        swPath2 = Left(swPath1, nomb)
        lettre = Left(swPath2, 1)
        swPath = Left(swPathName, InStrRev(swPathName, "\" & lettre, , 0))
        
        ' Pour savoir si le document est un plan
        If swModel.GetType = swDocDRAWING Then
            ' Pour récupérer les propriétés Solidworks
            Set swCustProp = swModel.Extension.CustomPropertyManager("")
            swCustProp.Get2 "REFERENCE PIECE", valOut1, resolvedValOut1
            swCustProp.Get2 "Révision", valOut2, resolvedValOut2
            ' Pour activer chaque feuille tour à tour
            vSheets = swModel.GetSheetNames
            For i = 1 To swModel.GetSheetCount
                swModel.ActivateSheet vSheets(i - 1)
                Set swSheet = swModel.GetCurrentSheet
                
                ' Pour enregistrer la feuille en DXF
                Set swModelDocExt = swModel.Extension
                Set swExportPDFData = swApp.GetExportFileData(1)
                swExportPDFData.ViewPdfAfterSaving = False
                nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".DXF"
                boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, swSheet.GetName)
                boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)
                ' Pour enregistrer la feuille en PDF
                Set swModelDocExt = swModel.Extension
                Set swExportPDFData = swApp.GetExportFileData(1)
                swExportPDFData.ViewPdfAfterSaving = True
                nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".PDF"
                boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, swSheet.GetName)
                boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)
            Next i
            Else: swApp.SendMsgToUser ("Cette macro fonctionne uniquement avec une mise en plan")
        End If
End Sub

 

2

Bonjour,

Il faut modifier dans la ligne suivante:

boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, swSheet.GetName)

C'est cette ligne qui n'exporte que la feuille active, il faut donc avoir différents critères dans la macro pour sélectionner la bonne action (toutes les feuilles, quelques unes…)

1 « J'aime »
3

Merci de ta réponse Cyril, je veux exporter toutes les feuilles, j'ai essayé en supprimant la boucle For i, mais ça ne fonctionne plus.

Je ne suis pas un expert en macro!

 

4

Bonjour fifounet44,

Voilà qui devrait faire ce que tu souhaites :

Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim swSheet As SldWorks.Sheet
Dim vSheets As Variant
Dim i As Integer
Dim valOut1 As String
Dim valOut2 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim objShell   As Shell
Dim Folder As Object
Dim objFolder  As Folder
Dim objFile As Object
Dim Path As String
Dim nomb1 As String
Dim nomb2 As String
Dim nomb3 As String
Dim lettre As String
Dim Path1 As String
Dim Path2 As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set Part = swApp.ActiveDoc
    Set objShell = New Shell
    
        swPathName = Part.GetPathName
        nomb1 = Len(swPathName)
        nomb2 = InStrRev(swPathName, "\")
        nomb3 = nomb1 - nomb2
        swPath1 = Right(swPathName, nomb3)
        nomb = nomb3 - 7
        swPath2 = Left(swPath1, nomb)
        lettre = Left(swPath2, 1)
        swPath = Left(swPathName, InStrRev(swPathName, "\" & lettre, , 0))
        
        ' Pour savoir si le document est un plan
        If swModel.GetType = swDocDRAWING Then
            ' Pour récupérer les propriétés Solidworks
            Set swCustProp = swModel.Extension.CustomPropertyManager("")
            swCustProp.Get2 "REFERENCE PIECE", valOut1, resolvedValOut1
            swCustProp.Get2 "Révision", valOut2, resolvedValOut2
            ' Pour activer chaque feuille tour à tour
            vSheets = swModel.GetSheetNames
                
            ' Pour enregistrer la feuille en DXF
            Set swModelDocExt = swModel.Extension
            Set swExportPDFData = swApp.GetExportFileData(1)
            swExportPDFData.ViewPdfAfterSaving = False
            nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".DXF"
            boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, vSheets)
            boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)
            ' Pour enregistrer la feuille en PDF
            Set swModelDocExt = swModel.Extension
            Set swExportPDFData = swApp.GetExportFileData(1)
            swExportPDFData.ViewPdfAfterSaving = True
            nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".PDF"
            boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, vSheets)
            boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

            Else: swApp.SendMsgToUser ("Cette macro fonctionne uniquement avec une mise en plan")
        End If
End Sub

Cordialement,

2 « J'aime »
5

 

Bonsoir,

Le code de d.roger   ou celui-ci:

boolstatus = swExportPDFData.SetSheets(swExportData_ExportAllSheets, "")

 

2 « J'aime »
6

Bonsoir d.roger,
Merci, j'essaie dès lundi matin, merci aussi Cyril !
Passez un bon we

7

Bonjour,
Je viens  d'essayer et ça fonctionne correctement.
quand je vois le code ça semblait simple, tout est plus facile quand on maitrise!
Merci encore.

 

1 « J'aime »