Macro export PDF & DXF page active

Bonjour,
N’ayant pas énormément de connaissance en macro et code VBA, je cherche à exporter la page en cours en PDF et DXF avec comme de nom de fichier :
Nom fichier Mise en plan_Indice de révision_Numéro de page_Nom de la page_Date du jour.

Après de multiples recherches et essais d’écriture d’une macro, je suis arrivé à un résultat qui ne me satisfait pas, Je n’arrive pas à récupérer toutes les données souhaitées : Numéro et nom de la page.
Quelqu’un peut-il m’aider ?

Ci-joint mon code :

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swDrawModel         As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc
Dim swCustProp          As CustomPropertyManager
Dim swView              As SldWorks.View
Dim swExportPDFData     As SldWorks.ExportPdfData
Dim sFileName           As String
Dim sPathname           As String
Dim Revision            As String
Dim resolvedRevision    As String
Dim sSheetName          As String
Dim sSheetNumber        As String
Dim dateNow             As String
Dim nErrors             As Long
Dim nWarnings           As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swDrawModel = swApp.ActiveDoc
    Set swDraw = swDrawModel
        
        ' Vérifier si une mise en plan est ouverte
        If swDrawModel Is Nothing Then
                MsgBox "Il n'y a pas de document de mise en plan ouvert."
                Exit Sub
        End If

        If swDrawModel.GetType <> swDocDRAWING Then
                MsgBox "Ouvrez d'abord une mise en plan, puis réessayez "
                Exit Sub
        End If

        If swDrawModel.GetPathName = "" Then
                MsgBox "Enregistrez d'abord le dessin, puis réessayez !"
                Exit Sub
        End If

    Set swView = swDraw.GetFirstView

    Set swView = swView.GetNextView

        ' Déterminer s'il y a une vue existante
        If swView Is Nothing Then
                MsgBox "Insérez d'abord une vue, puis réessayez !"
                Exit Sub
        End If

        ' On récupère le nom du fichier de la mise en plan
    sPathname = Replace(swDraw.GetPathName, ".SLDDRW", "")     ' Récupère le nom du fichier et enlève l'extension .SLDDRW
      
        ' On récupère les valeurs qui nous intéresse dans les propriétés personnalisées du plan
    Set swCustProp = swDraw.Extension.CustomPropertyManager("")
    swCustProp.Get2 "Révision", Revision, resolvedRevision      ' Récupère l'indice de Révision du fichier Mise en Plan
    
        ' On récupère la date du jour et on la met dans un format pouvant se mettre dans le nom d'un fichier
    dateNow = Replace(Date, "/", ".")
    
        ' On récupère les données de la feuille active
    'sSheetName = swDraw.ActivateSheet.GetSheetNames    ' Récupère le nom de la feuille active
    'sSheetNumber = swDraw.GetCurrentSheet              ' Récupère le numéro de la feuille active
     
        'Obtenir et définir le nom du fichier
    sFileName = sPathname & " - " & resolvedRevision & " - " & dateNow      'Code fonctionnel mais sans le numéro et le nom de la page
    'sFileName = sPathname & " - " & resolvedRevision & " - " & sSheetNumber & " - " & sSheetName  & " - " & dateNow        'Code non-fonctionnel voulu

    Set swExportPDFData = swApp.GetExportFileData(1)

    swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""

    swExportPDFData.ViewPdfAfterSaving = False

    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfActiveSheetOnly

        'Enregistrer au format DXF

    swDraw.Extension.SaveAs sFileName & ".DXF", 0, 0, Nothing, nErrors, nWarnings

        'Enregistrer au format PDF

    swDraw.Extension.SaveAs sFileName & ".PDF", 0, 0, swExportPDFData, nErrors, nWarnings

    End Sub

Merci beaucoup pour vos retour.
Manu

Une capture d’écran d’un nom de page et son numéro?
N° inclut dans le nom de la feuille ou dans l’ordre ou elles apparaissent?

1 « J'aime »

Bonjour Manu,

Voici ce que l’on utilise pour ce genre traitement.


…Voilà, voilà, voilà…
@+
AR.

Pour obtenir le nom d’une feuille:

vSheetName = swDraw.GetSheetNames
'On boucle sur les feuilles
For i = 0 To UBound(vSheetName)
        sheetName = vSheetName(i)
        'Debug.Print "Nom de feuille:" & sheetName

Next i

Pour modifier le nom de la feuille:

            swDraw.GetCurrentSheet.SetName "nom de la feuille"

Pour le N° soit le i (incrémentation), soit tu récupère le N° dans le nom de la feuille (suivant besoin)

1 « J'aime »

:smile:J’me disais bien que cette conversation me disais quelque chose, il s’agit bien de la suite de Macro export DXF feuille par feuille - #23 par Cyril_f n’est-ce pas ?
Les propositions précédentes ne convenaient pas ?
Hormis le Nom des feuilles, qui est une nouvelle demande, as-tu essayé de modifier ta macro ?
Ceci dit les propositions de @sbadenis sont tout à fait pertinentes… :grin:

1 « J'aime »

Bonjour,
C’est la suite de ce sujet là effectivement. A la différence que là je veux extraire la feuille active à l’écran et non toutes les feuilles de ma mise en plan.
La macro pour extraire toute ma mise en plan feuille par feuille fonctionne bien, à part que c’est relativement long (mais je me suis rendu compte que même sans passer par la macro, cela met autant de temps, donc le problème ne vient pas de la macro mais certainement de la lourdeur de mes mises en plan) et que je n’arrive pas à mettre le numéro de la feuille tout au début du nom de fichier, je n’arrive pas à comprendre pourquoi cela ne fonctionne pas, mais je m’en contente.
Pour revenir à ce sujet pour la feuille active je vais tester ce que tu me transmets. Et ci-joint une capture d’écran d’un exemple pour les noms des feuilles.

Et pour répondre à A_R, je connais bien BatchConverter car on l’utilisait dans mon ancienne entreprise, mais ayant changé de société avec une toute petite structure, il n’est pas du tout à l’ordre du jour d’investir dans une licence pour les outils myCad.

Merci pour vos retours et le temps que vous consacrez à me répondre en tout cas
Ce forum m’est d’une grande aide

Manu

1 « J'aime »

Re bonjour,

Alors après essais si j’utilise le code transmis :

    vSheetName = swDraw.GetSheetNames           ' Récupère le nom de la feuille active
            'On boucle sur les feuilles
                For i = 0 To UBound(vSheetName)
                        sSheetName = vSheetName(i)
                Next i

Cela me génère le nom de la dernière page de mon fichier et non celui de la page active :
image
Ici H6(3) alors que la page active était la H1(2)

J’ai essayé de modifier le code comme tel :

vSheetName = swDraw.GetSheetNames           ' Récupère le nom de la feuille active
            'On boucle sur les feuilles
                For i = 0 To UBound(vSheetName)
                        sSheetName = swDraw.ActivateSheet(vSheetName(i))
                Next i

Cela me génère la réponse « Vrai » dans le nom de fichier au lieu du nom de la page:
image

Et pour le numéro de page cela me génère un nombre égale au nombre total de pages du documents. Donc je comprends que le « i » est considéré comme le nombre total de pages.

Comment faire dans la macro, pour que le « i » corresponde à la page active et non au nombre total de pages ?

Si cela est trop complexe, je changerais mes habitudes et j’intégrerais le numéro de page directement dans le nom de la page (mais si pour quelques raisons que ce soit, je dois supprimer ou ajouter une page, il va falloir que je modifie le nom de toutes les pages…)

Avec l’aide de claude.ai voici le code fonctionnel obtenu:

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swDrawModel         As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc
Dim swCustProp          As CustomPropertyManager
Dim swView              As SldWorks.View
Dim swExportPDFData     As SldWorks.ExportPdfData
Dim sFileName           As String
Dim sPathname           As String
Dim Revision            As String
Dim resolvedRevision    As String
Dim sSheetName          As String
Dim sSheetNumber        As String
Dim dateNow             As String
Dim nErrors             As Long
Dim nWarnings           As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swDrawModel = swApp.ActiveDoc
    Set swDraw = swDrawModel
        
    ' Vérifier si une mise en plan est ouverte
    If swDrawModel Is Nothing Then
        MsgBox "Il n'y a pas de document de mise en plan ouvert."
        Exit Sub
    End If
    If swDrawModel.GetType <> swDocDRAWING Then
        MsgBox "Ouvrez d'abord une mise en plan, puis réessayez "
        Exit Sub
    End If
    If swDrawModel.GetPathName = "" Then
        MsgBox "Enregistrez d'abord le dessin, puis réessayez !"
        Exit Sub
    End If

    ' -------------------------------------------------------
    ' Récupération du nom de la feuille active
    ' -------------------------------------------------------
    Dim swSheet         As SldWorks.Sheet
    Dim vSheetNames     As Variant
    Dim i               As Integer

    Set swSheet = swDraw.GetCurrentSheet()
    sSheetName = swSheet.GetName()              ' Nom de la feuille active

    ' Récupération du numéro de la feuille active (index 1-based)
    vSheetNames = swDrawModel.GetSheetNames()   ' Tableau de tous les noms de feuilles
    sSheetNumber = "1"                          ' Valeur par défaut
    For i = 0 To UBound(vSheetNames)
        If vSheetNames(i) = sSheetName Then
            sSheetNumber = CStr(i + 1)          ' i=0 ? feuille n°1
            Exit For
        End If
    Next i

    Debug.Print "Feuille active : " & sSheetName & " (n°" & sSheetNumber & ")"
    ' -------------------------------------------------------

    ' On récupère le nom du fichier de la mise en plan
    sPathname = Replace(swDraw.GetPathName, ".SLDDRW", "")
    sPathname = Replace(sPathname, ".slddrw", "")   ' Sécurité casse minuscule

    ' On récupère les valeurs des propriétés personnalisées
    Set swCustProp = swDraw.Extension.CustomPropertyManager("")
    swCustProp.Get2 "Révision", Revision, resolvedRevision

    ' On récupère la date du jour formatée
    dateNow = Replace(Date, "/", ".")

    ' Construction du nom de fichier avec numéro et nom de feuille
    sFileName = sPathname & " - " & resolvedRevision & _
                " - F" & sSheetNumber & " - " & sSheetName & _
                " - " & dateNow

    ' Export PDF
    Set swExportPDFData = swApp.GetExportFileData(1)
    swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""
    swExportPDFData.ViewPdfAfterSaving = False

    ' Export DXF (feuille active uniquement)
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfActiveSheetOnly

    ' Enregistrer au format DXF
    swDraw.Extension.SaveAs sFileName & ".DXF", 0, 0, Nothing, nErrors, nWarnings

    ' Enregistrer au format PDF
    swDraw.Extension.SaveAs sFileName & ".PDF", 0, 0, swExportPDFData, nErrors, nWarnings

End Sub
'``

'**Les deux points clés du changement :**

'GetCurrentSheet()` retourne l'objet `Sheet` de la feuille active, dont on tire le nom via `.GetName()`.

'GetSheetNames()` retourne un tableau `Variant` de tous les noms de feuilles dans l'ordre. On boucle dessus pour trouver la position de la feuille active, en ajoutant 1 car le tableau est indexé à 0.

'Le nom de fichier généré aura la forme :
'``
'C:\...\MonDessin - RevA - F2 - Feuille2 - 23.02.2026.PDF

Donc merci Claude, qui je l’avoue, me sert de plus en plus pour ce genre de modification effectuée en quelques secondes.
Même si parfois cela bug et dans ce cas il faut savoir comprendre le code pour l’aider à corriger correctement.
Mais dans ce cas code fournit et fonctionnel du 1er coup.
Pour info toute ta partie avec swView est inutile.

Edit: pour ceux que ça intéresse la requête:
Bonjour, j’ai ce code en vba que je souhaite modifier je voudrai récupérer le nom de la feuille dans le nom d’export ainsi que le numéro de la feuille (active) en sachant que la 1ère feuille sera numéroté 1 puis le code initiale que j’ai collé.

2 « J'aime »

Au top, cela fonctionne à merveille !!!

Merci beaucoup!!!

1 « J'aime »