Makro pdf aktives Blatt mit bereits vordefinierter Datei

Hallo 

Ich habe ein Makro gefunden, das mir bis auf ein Detail passt: Ich möchte, dass es nur das aktive Blatt speichert oder dass wir auswählen können, welches Blatt gespeichert werden soll. 

Für den aktiven Blattteil habe ich Probleme beim Integrieren  von swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""

Es funktioniert nicht so, wie ich es versuche. 

Hier ist das fragliche Makro
 


pdf.swp

Für diejenigen, die Solidworks nicht unbedingt zur Hand haben, ist es am besten, den folgenden Code direkt einzufügen (Codeausschnitt einfügen, dann vbscript und einfügen):

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

 

Dieser Code sollte funktionieren:

    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 „Gefällt mir“

Hallo 

Vielen Dank für Ihren Code, wenn ich den Ordnerspeicherort hinzufügen möchte, den ich hinzuzufügen versuche: 

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

Aber es funktioniert nicht, gibt es eine andere Variable, die berücksichtigt werden muss? 

Auf den 1. Code oder den 2.?

In Ihrem Code 

Im 2. Makro ist es die sFilName-Zeile, die geändert werden muss

    '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 „Gefällt mir“

Perfekter Dank, ich möchte nur die Umbenennung Ihres ersten Makros beibehalten, denn dort hat sie mir den Namen des Blattes hinzugefügt. 

Oder kann ich Beispielcode für sfilename finden?

SFilname ist eine String-Variable, im Grunde ist es Text, um seinen Inhalt zu erstellen, bekomme ich den Namen des Blattes (swModel.GetTitle) und wir verketten Text mit einem & alles, was Text ist, ist zwischen "" und der Variablen ohne das ""

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

Wenn Sie im VBA-Editor das Ausführungsfenster (https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/use-the-immediate-window)

Und debug.print swModel.GetTitle sehen Sie die Rückgabe Ihrer Variablen. (Exponat1 - Blatt 1) zum Beispiel

Um den Namen zu behalten, müssen Sie die Variable manipulieren, um nur den Namen des Teils ohne die Variable zu behalten, siehe dazu diese Seite:

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

Mit der Teilung suchen wir die Position des - von "Teil1  - Blatt1"

Wenn wir links mit der Position-1 verwenden, die mit split gefunden wurde, erhalten wir nur den Namensteil der Variablen

Wir müssen daher die vorherige Zeile sFilename ersetzen durch:

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

 

Danke, es funktioniert perfekt