Amélioration Macro PDF

allancomment · Mars 24, 2016, 8:24

Bonjour,

Pour faire suite au sujet de la macro PDF (http://www.lynkoa.com/forum/cao/macro-d-enregistrement-pdf-dans-dossier-actuel#answer-617678), j'aimerais maintenant améliorer un "bug", non bloquant pour l'utilisation de la macro mais quelque peu embetant à la longue.

Lorsqu'un plan .PDF est ouvert à l'atelier pour consultation et que je dois faire une modif. sur ce même plan directement sur Solidworks, et que j'utilise cette macro PDF, Solidworks plante et se ferme, car il ne peut pas écraser le fichier PDF puisqu'il est déjà ouvert.

Cependant quand j'essaye d'enregistrer en .PDF le plan en passant par "Fichier"-"Enregistrer sous-.PDF", le message "Ce fichier est en lecture seule" apparait et permet à Solidworks de ne pas planter.

Serait-il possible de récupérer une ligne de code dans ma macro qui me permettrais d'avoir ce message lorsque le fichier est déjà ouvert, et de ne pas faire planter Solidworks?

Voici la macro que .PL m'avais proposé (merci encore!) :

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

'obtient le chemin complet du document actif, y compris le nom du fichier :
PathName = UCase(Part.GetPathName)

Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
boolstatus = Part.EditRebuild3()
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ViewZoomtofit2
longstatus = Part.SaveAs3(Replace(UCase(PathName), "SLDDRW", "PDF"), 0, 0)
End Sub

D'avance merci à vous pour votre aide,

Cordialement,

Allan.

pl · Mars 24, 2016, 8:29

Bonjour,

Il faut vérifier si le fichier est ouvert pour créer un msgbox d'avertissement.

Voir cette page :

https://support.microsoft.com/en-us/kb/153058

Et voilà le code :

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
'obtient le chemin complet du document actif, y compris le nom du fichier :
PathName = UCase(Part.GetPathName)
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
boolstatus = Part.EditRebuild3()
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ViewZoomtofit2
If GetAttr(Replace(UCase(PathName), "SLDDRW", "PDF") And vbReadOnly Then
MsgBox "Fichier en lecture seule"
Else
longstatus = Part.SaveAs3(Replace(UCase(PathName), "SLDDRW", "PDF"), 0, 0)
End If
End Sub

ac_cobra_427 · Mars 24, 2016, 8:53

Bonjour,

voici celle que nous utilisont, elle enregitre le fichier avec son nom dans le dossier de la mise en plan.

macro_pdf.swp

allancomment · Mars 24, 2016, 12:02

Merci beaucoup pour ta réponse .PL, cependant la macro ne marche pas, apparement il y'a un problème au niveau de cette ligne: If GetAttr(Replace(UCase(PathName), "SLDDRW", "PDF") And vbReadOnly Then

En jetant un oeil au lien que tu m'a également fourni j'ai vu qu'il devrait y'avoir un point avant le ReadOnly, mais j'ai essayé de le rajouter et celà n'a rien changé.

Merci d'avance, et désolé pour mon ignorance totale en codification VBA...

pl · Mars 24, 2016, 12:59

Il manquait une parenthèse entre GetAttr(Replace(UCase(PathName), "SLDDRW", "PDF") et AND,

Voila le nouveau code :

Suppression code

pl · Mars 24, 2016, 1:05

J'ai modifié le code pour le cas ou le fichier PDF n'existe pas, le voilà :

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
'obtient le chemin complet du document actif, y compris le nom du fichier :
PathName = UCase(Part.GetPathName)
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
boolstatus = Part.EditRebuild3()
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ViewZoomtofit2

If Dir(Replace(UCase(PathName), "SLDDRW", "PDF")) <> "" Then
If GetAttr(Replace(UCase(PathName), "SLDDRW", "PDF")) And vbReadOnly Then
MsgBox "Fichier en lecture seule"
Else
longstatus = Part.SaveAs3(Replace(UCase(PathName), "SLDDRW", "PDF"), 0, 0)
End If

End if
End Sub

allancomment · Mars 24, 2016, 1:36

Merci .PL tu te démènes pour moi, malheureusement la macro ne marche toujours pas, elle ne génère rien du tout.

J'essaye de faire le maximum pour ne pas te faire perdre de temps, donc j'ai refait le tour des parenthèses etc mais je ne vois rien désolé, le code me parait bon...

pl · Mars 24, 2016, 3:09

Il y a une erreur ou rien ne se passe ?

pl · Mars 24, 2016, 3:12

Désolé, petite erreur de ma part, ça m'apprendra à ne pas assez tester !

Maintenant ça devrait marcher !

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
'obtient le chemin complet du document actif, y compris le nom du fichier :
PathName = UCase(Part.GetPathName)
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
boolstatus = Part.EditRebuild3()
Part.ViewZoomtofit2
Part.ViewZoomtofit2
Part.ViewZoomtofit2

If Dir(Replace(UCase(PathName), "SLDDRW", "PDF")) <> "" Then
If GetAttr(Replace(UCase(PathName), "SLDDRW", "PDF")) And vbReadOnly Then
MsgBox "Fichier en lecture seule"
Else
longstatus = Part.SaveAs3(Replace(UCase(PathName), "SLDDRW", "PDF"), 0, 0)
End If

Else
longstatus = Part.SaveAs3(Replace(UCase(PathName), "SLDDRW", "PDF"), 0, 0)

End if
End Sub

allancomment · Mars 25, 2016, 6:30

Merci pour cette nouvelle macro, effectivement elle fonctionne mais sous certaines conditions, et pour résoudre à celà je ne sais pas si c'est moi qui doit régler quelque chose ou si la macro peut être améliorée.

Quand j'ouvre une mise en plan et que je crée un nouveau PDF, pas de souçis.

Par contre quand j'essaye de générer le PDF depuis la mise en plan alors que celui-ci est ouvert, ça me fait planter Solidworks comme avant.

Ce problème est résolu quand j'ouvre le PDF après avoir coché la case "Attributs : Lecture seule" dans les propriétés. A ce moment là la macro fonctionne et le message "Fichier en lecture seule" apparait bien quand j'essaye de générer le PDF. Seulement après avoir fermé le PDF, en essayant de re générer, le message "Fichier en lecture seule" apparait toujours, comme si le fichier restait ouvert, alors que non. J'arrive à palier le problème en décochant "Attributs : Lecture seule" dans les propriétés, et là le PDF veut bien se re générer.

Est-ce que c'est à moi de régler des droits de lecture/écriture ou est ce que la macro doit être modifiée?

Merci pour ton aide.

ac_cobra_427 · Mars 25, 2016, 10:12

Avez-vous pu tester la mienne?

allancomment · Mars 29, 2016, 5:40

Bonjour Manu67, je n'ai pas pu tester ta macro car quand je clique sur le lien de ta réponse, celà m'ouvre un code indéscriptible, j'ai d'ailleurs ce même problème pour tous les liens de pièce jointe en message sur le forum.

Cyril.f · Mars 29, 2016, 4:47

Bonsoir,

Sauf erreur de ma part, l'attribut lecture seule n'est pas extractible sur les fichiers pdf de manière directe.

Il faudrait regarder du coté des fonctions de suppression de fichier de la méthode file (voir: http://warin.developpez.com/access/fichiers/#LI-D-2) et appliquer le traitement voulu en fonction du résultat (si erreur --> Fichier en lecture seule).

ac_cobra_427 · Mars 30, 2016, 3:51

Voici la macro que l'on utilse:

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim lErrors As Long
Dim lWarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " rev." & swModel.GetCustomInfoValue("", "Révision") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings

End Sub

Function GetFilename(strPath As String) As String
    Dim strTemp As String
    strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
    GetFilename = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function

ac_cobra_427 · Mars 31, 2016, 5:39

Bonjour,

voici celle qui fonctionne et je viens de la tester:

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim lErrors As Long
Dim lWarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " rev." & swModel.GetCustomInfoValue("", "Révision") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings

End Sub

Function GetFilename(strPath As String) As String
Dim strTemp As String
strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
GetFilename = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function

martvy · Mars 31, 2016, 12:32

Bonjour,

J'ai exactement le même problème, je vais tester vos solution voir si ça fonctionne et j'aimerais bien pousser le vice encore plus loin. Quand un plan pdf est ouvert dans l'explorateur windows dans le volet de visualisation, la sauvegarde se passe bien en apparence mais le fichier pdf est illisible. Une explication ?

Allez, je vais tester vos codes !

martvy · Mars 31, 2016, 1:31

Petits retour après des essais.

Pour ma part le code de PL ne fonctionne pas.

manu67, j'ai pas essayé ton code parce que je ne le comprend pas (et comme j'aime bien comprendre ce que je fait...)

J'ai donc fait des recherches et je suis arrivé sur ça :

https://support.microsoft.com/en-us/kb/291295

à compléter avec ça (car problème d'erreur 75) : http://stackoverflow.com/questions/12599322/check-if-a-file-is-already-open-vba

ça marche bien, ca détecte si le pdf est ouvert sur un autre poste. par contre la je viens de quitter les pdfs ouverts sur un autre poste et ça me dit toujours qu'ils sont ouverts... a voir si ça revient tout seul, si c'est du au serveur....