Aktywny arkusz makra pdf z już predefiniowanym plikiem

3D Design
1

Witam 

Znalazłem makro, które mi odpowiada, z wyjątkiem jednego szczegółu, chciałbym, aby zapisywało tylko aktywny arkusz lub abyśmy mogli wybrać, który arkusz chcesz zapisać. 

dla aktywnej części arkusza mam problem z integracją  swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""

To nie działa tak, jak próbuję. 

Oto makro, o którym mowa 
 


pdf.swp (w języku angielskim)
2

Dla tych, którzy niekoniecznie mają pod ręką Solidworks, najlepiej jest umieścić następujący kod bezpośrednio (wstaw fragment kodu, a następnie vbscript i wklej):

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

Ten kod powinien działać:

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

Witam 

Dzięki za kod, jeśli chcę dodać lokalizację folderu, którą próbuję dodać: 

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

Ale to nie działa, czy jest jakaś inna zmienna, którą należy wziąć pod uwagę? 

5

Na 1. kodzie czy na 2.?

6

W kodzie 

7

W 2. makrze należy zmodyfikować wiersz sFilName

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

Doskonale, dziękuję, chciałbym tylko zachować zmianę nazwy twojego pierwszego makra, ponieważ tam dodała mi nazwę arkusza. 

Czy mogę znaleźć przykładowy kod dla sfilename?

9

SFilname to zmienna łańcuchowa, w zasadzie jest to tekst, aby utworzyć jego zawartość, otrzymuję nazwę arkusza (swModel.GetTitle) i łączymy tekst z & wszystko, co jest tekstem, znajduje się między "" a zmienną bez ""

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

Jeśli w edytorze VBA zostanie wyświetlone okno wykonywania (https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/use-the-immediate-window)

I debug.print swModel.GetTitle zobaczysz zwrot swojej zmiennej. (Załącznik 1 - Arkusz 1) na przykład

Aby zachować nazwę, musisz manipulować zmienną, aby zachować tylko nazwę części bez zmiennej, w tym celu zobacz tę stronę:

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

Za pomocą split szukamy pozycji - z "part1  - sheet1"

Używając left z pozycją-1 znalezioną za pomocą split, otrzymujemy tylko część nazwy zmiennej

W związku z tym musimy zastąpić poprzednią linię sFilename następującymi elementami:

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

 

10

Dziękuję, działa idealnie