Macro pdf actief blad met reeds vooraf gedefinieerd bestand

3D Design
1

Hallo 

Ik heb een macro gevonden die bij mij past, behalve één detail, ik zou graag willen dat alleen het actieve blad wordt opgeslagen of dat we kunnen selecteren welk blad we willen opslaan. 

voor het actieve bladgedeelte heb ik problemen met het integreren van  swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""

Het werkt niet zoals ik het probeer. 

Hier is de macro in kwestie 
 


pdf.swp
2

Voor degenen die niet per se Solidworks bij de hand hebben, is het het beste om de volgende code direct in te voeren (voeg een codefragment in, vervolgens vbscript en plak):

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

Deze code zou moeten werken:

    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

Hallo 

Bedankt voor uw code als ik de maplocatie wil toevoegen die ik probeer toe te voegen: 

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

Maar het werkt niet, is er een andere variabele om rekening mee te houden? 

5

Op de 1e code of de 2e?

6

Op je code 

7

In de 2e macro is het de sFilName-regel die moet worden gewijzigd

    '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 bedankt, ik wil gewoon de hernoeming van je eerste macro behouden, want daar voegde ze de naam van het blad aan mij toe. 

Of kan ik een voorbeeldcode voor sfilename vinden?

9

SFilname is een stringvariabele, in feite is het tekst, om de inhoud te creëren krijg ik de naam van het blad (swModel.GetTitle) en we voegen tekst samen met een & alles wat tekst is, is tussen "" en de variabele zonder de ""

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

Als u in de VBA-editor het uitvoeringsvenster (https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/use-the-immediate-window) weergeeft

En debug.print swModel.GetTitle ziet u de terugkeer van uw variabele. (Bewijsstuk 1 - Blad1) bijvoorbeeld

Om de naam te behouden moet je de variabele manipuleren om alleen de naam van het deel te behouden zonder de variabele, hiervoor zie deze pagina:

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

Met behulp van split zoeken we naar de positie van de - van "part1  - sheet1"

Als we links gebruiken met de positie-1 gevonden met splitsing, krijgen we alleen het naamgedeelte van de variabele

We moeten daarom de vorige sFilename-regel vervangen door:

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

 

10

Bedankt, het werkt perfect