Bonjour,
J'ai créer une macro à l'aide de ce que j'ai trouvé, elle doit me convertir ma MEP en pdf et l'enregistrer dans le dossier de l'année dans laquelle elle a été créé, si le dossier n'existe pas le créer.
La voici:
Dim swApp As Object
Dim Part As Object
Dim NomFichierPDF As String
Sub main()
Dim swApp As SldWorks.SldWorks
Dim SWmoddoc As SldWorks.ModelDoc2
Dim NuméroPlan As String
Dim CheminFichier As String
Dim NomFichier As String
Dim NombreFeuille As String
Dim NomFichierPDF As String
Dim CheminNomFichierPDF As String
Dim NomDossierPDF As String
Dim nErrors As Long
Dim nWarnings As Long
Set swApp = Application.SldWorks
Set SWmoddoc = swApp.ActiveDoc
'Récupération du chemin et du nom de fichier
'Exmple : \\MERCURE\Partage\xMethodes\Public\DAO\Solidworks\2 - Mise en plan\2014\046-1-2014-A.SLDDRW
PathName = SWmoddoc.GetPathName
CheminFichier = Left(PathName, InStrRev(PathName, "\")) '\\MERCURE\Partage\xMethodes\Public\DAO\Solidworks\2 - Mise en plan\2014\
NomFichier = Right(PathName, Len(PathName) - InStrRev(PathName, "\")) '046-1-2014-A.SLDDRW
NomDossierPDF = Right(NomFichier, 13) '2014-A.SLDDRW
NomDossierPDF = Left(NomDossierPDF, 4) '2014
CheminNomFichierPDF = "\\MERCURE\Partage\xMethodes\Public\DAO\Plans PDF\" & NomDossierPDF '\\MERCURE\Partage\xMethodes\Public\DAO\Plans PDF\2014\
'------------------------------------------------------------------
'Récupération des propriétés personnalisées du fichier plan
If SWmoddoc.GetType = swDocDRAWING Then 'vérification que l'on est bien sur un fichier plan
NomFichierPDF = Replace(NomFichier, "SLDDRW", "pdf")
End If
'------------------------------------------------------------------
'Test si le dossier avec l'année existe, si non le créer
If Dir$(CheminNomFichierPDF) = "" Then
MkDir "NomDossierPDF"
End If
'------------------------------------------------------------------
'Test si le fichier existe déjà ou confirmation
'puis enregistrement
If Dir$(CheminNomFichierPDF) = NomFichierPDF Then 'Le fichier existe déjà
If MsgBox("Le fichier : " & NomFichierPDF & vbNewLine & "existe déjà. Voulez-vous le remplacer?", _
vbOKCancel + vbExclamation) = vbOK Then
nErrors = SWmoddoc.SaveAs(CheminNomFichierPDF)
Else
If MsgBox("Le fichier PDF n'a pas été créé.", vbInformation) = vbOK Then Exit Sub '-------Message et SORTIE-------
End If
Else
If MsgBox("Le fichier : " & NomFichierPDF & vbNewLine & " va être créé", vbOKCancel + vbInformation) = vbOK Then
nErrors = SWmoddoc.SaveAs(CheminNomFichierPDF)
Else
If MsgBox("Le fichier PDF n'a pas été créé.", vbInformation) = vbOK Then Exit Sub '-------Message et SORTIE-------
End If
End If
End Sub
Je ne sais pas comment la tester et je voudrais savoir avant de la lancé si je n'ai pas fait de connerie car cela joue avec les dossiers du réseau de ma boite.
Merci d'avance.