Makro-Export PDF & DXF aktive Seite

Macro
1

Hallo,
Da ich nicht viel Kenntnisse in Makro- und VBA-Code habe, möchte ich die aktuelle Seite als PDF und DXF mit folgendem Dateinamen exportieren:
Dateiname: Einstellung plan_Indice page_Nom révision_Numéro der Tages-page_Date.

Nach mehreren Suchen und Versuchen, ein Makro zu schreiben, bin ich zu einem Ergebnis gekommen, das mich nicht zufriedenstellt: Ich kann nicht alle gewünschten Daten abrufen: Nummer und Name der Seite.
Kann mir jemand helfen?

Angehängt ist mein 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

Vielen Dank für dein Feedback.
Manu

2

Ein Screenshot eines Seitennamens und seiner Nummer?
N° im Namen des Blattes oder in der Reihenfolge, in der sie erscheinen?

1 „Gefällt mir“
3

Hallo Manu,

Hier ist, was für diese Art von Behandlung verwendet wird.

2026-02-20_132442
2026.02.132442906×661 93,1 KB

… Da hast du es, da hast du es, da hast du es...
@+
AR.

4

Um den Namen eines Blattes zu erhalten:

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

Um den Namen des Blattes zu ändern:

            swDraw.GetCurrentSheet.SetName "nom de la feuille"

Für das N° entweder das i (Inkrement) oder du bekommst das N° im Namen des Blatts (falls nötig)

1 „Gefällt mir“
5

:smile:Ich dachte, dieses Gespräch sagt mir etwas: Es ist die Macro DXF Exportsuite Blatt für Blatt – #23 von Cyril_f oder?
Waren die vorherigen Vorschläge nicht geeignet?
Abgesehen vom Blattnamen, der eine neue Anfrage ist, hast du versucht, dein Makro zu ändern?
Das gesagt, sind @sbadenis Vorschläge sehr relevant... :grin:

1 „Gefällt mir“