Macro pdf feuille active avec dossier déjà prédifini

3D Design
1

Bonjour , 

J'ai trouvé une macro qui me convient à un détail près j'aimerai qu'elle enregistre uniquement la feuille active ou qu'on puisse sélectionner quel feuille enregistrer. 

pour la partie feuille active , j'ai du mal à intégrer  swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""

Cela ne fonctionne pas comme j'essaie. 

Voici la macro en question 
 


pdf.swp
2

Pour ceux qui n'ont pas forcément Solidworks sous la main il est préférable de mettre directement le code que voici (insérer un extrait de code puis vbscript puis coller):

Dim swApp               As Object
Dim Part                As SldWorks.ModelDoc2
Dim swView              As SldWorks.View
Dim swModExt            As SldWorks.ModelDocExtension
Dim Prop                As SldWorks.CustomPropertyManager
Dim swExportPDFData     As SldWorks.ExportPdfData
Dim boolstatus          As Boolean
Dim swModel             As SldWorks.ModelDoc2
Dim swPathName          As String
Dim swPath              As String
Dim swName              As String
Dim ValOut              As String
Dim Att                 As String
Dim OldAtt              As String
Dim iAtt                As Integer
Dim Errors              As Long
Dim Warnings            As Long
Dim oFSO                As Scripting.FileSystemObject
Dim oFld                As Folder
Const swDocDRAWING = 3

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc 'associe part au document en cours
Set oFSO = New Scripting.FileSystemObject

If Part.GetType = swDocDRAWING Then 'verif type document
      
    'reconstruction de la mise ne plan
    Part.ForceRebuild3 True
       
    'récupération du chemin complet
    swPathName = Part.GetPathName
    If swPathName = "" Then
        swApp.SendMsgToUser ("Le fichier de mise en plan n'est pas enregistré, veuillez le faire et recommencer")
        Exit Sub
    End If
    
    'affectation de l'emplacement du dossier
    swPath = Left(swPathName, InStrRev(swPathName, "à envoyé", , 1))
    swPath = swPath & "U:\à envoyé\"
       
    'récupération du nom
    swName = Right(swPathName, Len(swPathName) - InStrRev(swPathName, "\"))
    swName = Left(swName, InStrRev(swName, ".") - 1)
    
        
    swPathName = swPath + swName
    
suite:
    
    swPathName = swPathName + ".pdf" ' ajoute .pdf"
    Set swModExt = Part.Extension
    Part.ViewZoomtofit2
    boolstatus = swModExt.SaveAs(swPathName, 0, 0, swExportPDFData, Errors, Warnings) 'sauvegarde en pdf
    
    Else: swApp.SendMsgToUser ("Cette macro fonctionne uniquement avec une mise en plan")
    
    
   
    
End If

Fin:
    
End Sub

 

3

Ce code devrait fonctionner:

    Option Explicit
      
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swExportPDFData     As SldWorks.ExportPdfData
    Dim sFilename           As String
    Dim nErrors             As Long
    Dim nWarnings           As Long
      
    Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swExportPDFData = swApp.GetExportFileData(1)
      
    sFilename = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1)
    swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""
    swExportPDFData.ViewPdfAfterSaving = False
    swModel.Extension.SaveAs sFilename & ".PDF", 0, 0, swExportPDFData, nErrors, nWarnings
      
    End Sub

 

1 « J'aime »
4

Bonjour , 

merci sur ton code si je veux rajouter l'emplacement de dossier j'essaie de rajouter : 

swPath = Left(swPathName, InStrRev(swPathName, "à envoyé", , 1))
swPath = swPath & "U:\à envoyé\"

Mais ça ne fonctionne pas y a d'autre variable à prendre en compte ? 

5

Sur le 1er code ou le 2ème?

6

Sur ton code 

7

Dans la 2ème macro c'est la ligne sFilName qu'il faut modifier

    'on ajoute 'à la ligne ci-dessous afin de l'ignorer (passe la ligne en commentaire)
    'sFilename = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1)
    'On ajoute le chemin et le nom du fichier ci-dessous
    sFilename = "C:\Temp\Essai1\" & swModel.GetTitle
    
    Debug.Print sFilename

 

2 « J'aime »
8

Parfait merci , j'aimerai juste garder le renommage de ta première macro , parce que la elle m'a ajoute le nom de la feuille. 

Ou c'est que je peux trouver des exemple de code pour sfilename ?

9

SFilname est une variable de type string en gros c'est du texte, pour créer son contenu je récupère le nom de la feuille (swModel.GetTitle) et on lui concatène du texte avec un & tout ce qui est texte est entre "" et les variable sans les ""

soit "C:\Temp\Essai1\".swModel.GetTitle

Si tu affiche dans l'éditeur VBA la fenêtre execution (https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/use-the-immediate-window)

Et debug.print swModel.GetTitle tu verra le retour de ta variable. (Pièce1 - Feuille1) par exemple

Pour garder le nom il faut manipuler la variable pour garder que le nom de la pièce sans la variable pour cela voir cette page:

https://silkyroad.developpez.com/VBA/ManipulerChainesCaracteres/

En utilisant split on recherche la position du - de "pièce1  - feuille1"

En utilisant left avec la position-1 trouvé avec split on récupère uniquement la partie nom de la variable

Il faut donc remplacer la ligne sFilename précédente par:

sFilename = "C:\Temp\Essai1\" & Left(swModel.GetTitle, (InStr(swModel.GetTitle, "-")) - 1)

 

10

Je te remercie , elle fonctionne parfaitement