Je n’ai pas trouvé de post similaires dans le forum donc je me permet de le publier.
N’ayant aucune compétence dans le VBA j’ai trouvé une macro d’export PDF sur internet, et je souhaite la modifier.
Actuellement, elle enregistre automatiquement la MEP en PDF dans le dossier où se situe le fichier. Nos fichiers MEP sont situés dans une bibliothèque dans un réseau et s’appellent « 902xxxx »
Il me faudrait 2 fonctionnalités supplémentaires :
Incrémenter le nouveau fichier PDF de « plan pièce » au début du nom.
= « plan pièce 902xxxx »
Enregistrer le fichier PDF dans un autre emplacement que celui de la MEP : les PDF sont rangés dans un autre répertoire et dans des sous dossier nommés « 902xx » mais dans le même réseau .
Exemple :
J’ai un plan « 9021325 » se trouvant dans U : Etudes
Je veux l’enregistrer avec la macro en PDF pour qu’ils se retrouve dans le dossier U : Dosfab / 90213 en se renommant « plan pièce 9021325 »
La recherche sur ce forum n’est pas idéale… et pourtant en écrivant juste « PDF » on tombe sur quelques résultats intéressants.
dont la discussion :
ou encore mieux:
intéressante pour son coté didactique. @sbadenis y propose une macro bien commentée que vous devriez pouvoir modifier sans trop de difficultés: (Voici la copie du code).
' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim FileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long
'Dim lgFichier As Integer
Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks
' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc
' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
MsgBox "Un document doit être actif dans Solidworks.", vbCritical
End
End If
' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
End
End If
' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
swModel.Save
End If
' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName
'on récupère le chemin complet sans le nom de fichier
FilePath = Left(Path, InStrRev(Path, "\"))
'Debug.Print "Filepath:" + Filepath
'on récupère le nom du fichier sans l'extension
FileName = Mid(Path, Len(FilePath) + 1, Len(Path) - (7 + Len(FilePath)))
' on affiche la variable dans la fenêtre Exécution
Debug.Print "FileName=" & FileName
' on affiche la variable dans la fenêtre Exécution
Debug.Print "Path=" & Path
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
Path = Left(Path, lgFichier)
End If
' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "PathDesktop=" & PathDesktop
' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False
' On définit le chemin et le nom du premier fichier pdf à créer
'nFileName = Left(Path, Len(Path) - 6) & "PDF" 'Retrait de l'extension SW en gardant le point et ajout PDF
nFileName = FilePath & FileName & ".pdf"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName=" & nFileName
' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)
' On définit le chemin et le nom du deuxième fichier pdf à créer
'nFileName2 = PathDesktop & Left(nFileName2, Len(nFileName2) - 6) & "PDF"
nFileName2 = PathDesktop & "\" & FileName & ".pdf"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName2=" & nFileName2
' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)
End Sub