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
Ich dachte, dieses Gespräch sagt mir etwas: Es ist die 
