Macro pdf active sheet with already predefined file

3D Design
1

Hello 

I found a macro that suits me except for one detail, I would like it to save only the active sheet or that we can select which sheet to save. 

for the active sheet part, I have trouble integrating  swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""

It doesn't work the way I try. 

Here's the macro in question 
 


pdf.swp
2

For those who don't necessarily have Solidworks on hand, it's best to put the following code directly (insert a code snippet, then vbscript and paste):

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

This code should work:

    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 Like
4

Hello 

Thanks on your code if I want to add the folder location I try to add: 

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

But it doesn't work, is there any other variable to take into account? 

5

On the 1st code or the 2nd?

6

On your code 

7

In the 2nd macro, it is the sFilName line that needs to be modified

    '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 Likes
8

Perfect thank you, I'd just like to keep the renaming of your first macro, because there she added the name of the sheet to me. 

Or can I find sample code for sfilename?

9

SFilname is a string variable, basically it's text, to create its content I get the name of the sheet (swModel.GetTitle) and we concatenate text with a & all that is text is between "" and the variable without the ""

or "C:\Temp\Test1\".swModel.GetTitle

If you display in the VBA editor the execution window (https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/use-the-immediate-window)

And debug.print swModel.GetTitle you will see the return of your variable. (Exhibit1 - Sheet1) for example

To keep the name you have to manipulate the variable to keep only the name of the part without the variable for this see this page:

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

Using split we look for the position of the - of "part1  - sheet1"

Using left with the position-1 found with split we get only the name part of the variable

We must therefore replace the previous sFilename line with:

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

 

10

Thank you, it works perfectly