J’ai repris cette macro sur le net pour enregistrer mes mises en plans directement en pdf.
Malheureusement étant débutant dans le domaine, je ne sais pas comment ajouter le chemin du dossier d’enregistrement des mes mises en plans.
Quelqu’un peut-il m’indiqué la marche à suivre ?
Voici la macro que j’ai trouvé si cela peut aider, elle fonctionne mais enregistre les PDF dans le même dossier que mes mises en plan SW.
Merci d’avance !
Cordialement,
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
Le chemin sera dans un dossier dédié au plan en PDF qui est différent de celui au format SW.
Mais dans le temps l’emplacement changera car je fonctionne par dossier de 1000 plans et cela va très vite. (dossier dans un serveur dédié)
Par ailleurs, je ne suis pas sur d’avoir compris ce que je dois faire dans la macro de @sbadenis et à quel endroit de doit ajouté mon chemin
Le chemin était déjà ajouté en dur (vers le bureau)
Comment veux tu utiliser la macro?
Cas N°1 fichier par fichier la macro te demande ou tu veux enregistrer ton fichier à chaque fichier (ce qui peux être vite casse-pied si 100 fichiers à enregistrer)
Cas N°2 dans un sous répertoire de ton fichier (toujours identique)
Cas N°3 (celui que j’avais choisit) sur le bureau (Au besoin ajouter Plans/ derrière Desktop pour avoir un dossier sur le bureau) .
J’ai un dossier Mise en plan PDF et à l’intérieur j’ai plusieurs dossiers ranger par tranche de 1000 plan pdf.
Exemple:
1-1000
1001-2000
2001-3000
Je pense que je vais mettre la macro en bouton dans ma barre d’outil et il enregistrera dans l’emplacement que j’ai choisi et je l’a changerai par la suite.
Il faut juste que je remplace le chemin vers le bureau avec celui que je veux si je comprends bien, je vais faire un essai.
Mon chemin actuel est comme ça :
O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
Par ```
strFilename = « O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000 »& strFilename
Et le jour ou tu aura dépassé tes 1000 tu changes de nouveau cette ligne dans la macro
Effectivement erreur il manquait un \ après 19000, voici le code modifié et complet et testé:
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = "O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000\" & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
Il faut également que le dossier 18001-19000 soit déjà existant avant de lancer la macro
Par curiosité, Es ce que ce serait complexe, de faire retrouver automatique le bon dossier à la macro quand j’aurai passé le cap des numéros de plans ?
Tu récupères les 2 1er chiffres et on modifie le nom du dossier en conséquence.
Cela ajouterais quelques ligne de code mais rien d’extraordinaire.
Par contre il faut également créé le dossier si inexistant.
Non pour moi c’est réalisable via macro par contre cela rajouterais quelques lignes de code et il faut être sur que le nom de fichier de la MEP est bien compris lui aussi dans les valeurs indiqué par le dossier (exemple 18001.slddrw-> dossier 18001-19000)
Peut-tu donner le nom exact d’une mise en plan pour exemple?
Car l’idée serai de récupérer via macro les 1er chiffre et suivant ces chiffre d’enregistrer dans le répertoire existant ou de créer le dossier si on passe au millier supérieur.
Voici le code modifié pour la création automatique du nom de dossier si les MEp sont bien sous cette forme:
18001.slddrw, 19000.slddrw ou 20000.slddrw…
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim FolderName As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
FolderName = Left(strFilename, Len(strFilename) - 7)
Debug.Print Right(FolderName, Len(FolderName) - 2)
If Right(FolderName, Len(FolderName) - 2) = "000" Then
'Si la MEP se termine par 000 on créer le dossier avec avec comme début de N° FolderName-1
FolderName = (Left(FolderName, Len(FolderName) - 3) - 1) & "001-" & (Left(FolderName, Len(FolderName) - 3)) & "000"
Else
'Si la MEP ne se termine pas par 000 on créer le dossier avec comme début de N° FolderName
FolderName = Left(FolderName, Len(FolderName) - 3) & "001-" & (Left(FolderName, Len(FolderName) - 3) + 1) & "000"
End If
FolderName = "O:\Base SolidWorks\03-Bibliothèque PDF\" & FolderName & "\"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(FolderName, vbDirectory + vbHidden) = "" Then
MkDir FolderName
End If
strFilename = FolderName & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub