【宏】多页工程图分页保存PDF

o1ojacko1o

使用方法：
打开多页工程图文件，运行宏。
保存位置 需要手动修改，默认为 C:\test

代码如下：

1. Option Explicit
   
2. Dim swApp                   As SldWorks.SldWorks
   
3. Dim part                    As SldWorks.ModelDoc2
   
4. Dim swSheet                 As SldWorks.Sheet
   
5. Dim vSheetNames             As Variant
   
6. Dim swExportPDFData         As SldWorks.ExportPdfData
   
7. Dim swModelDocExt           As SldWorks.ModelDocExtension
   
8. Dim SheetCount              As Integer
   
9. Dim boolstatus              As Boolean
   
10. Dim i                       As Long
    
11. Dim Foldname                As String
    
12. Dim PDFname                 As String
    
13. Dim lErrors             As Long
    
14. Dim lWarnings           As Long
    
15. Dim AllSheetName
    
16. Dim SheetProperty
    
17. 
    
18. 
    
19. Sub main()
    
20.      
    
21.     Foldname = "C:\test"
    
22.     '指定PDF保存目录 手动改写
    
23.     Set swApp = Application.SldWorks
    
24.     swApp.Visible = True
    
25.     Set part = swApp.ActiveDoc
    
26.     Set swModelDocExt = part.Extension
    
27.     Set swExportPDFData = swApp.GetExportFileData(1)
    
28.      SheetCount = part.GetSheetCount
    
29.     AllSheetName = part.GetSheetNames
    
30. For i = 0 To SheetCount - 1
    
31.         part.ActivateSheet (AllSheetName(i))
    
32.         Set swSheet = part.GetCurrentSheet
    
33.         SheetProperty = swSheet.GetProperties
    
34.         PDFname = Foldname & AllSheetName(i) & ".pdf"
    
35.         vSheetNames = AllSheetName
    
36.           boolstatus = swExportPDFData.SetSheets(swExportData_ExportCurrentSheet, vSheetNames)
    
37.            swExportPDFData.ViewPdfAfterSaving = True
    
38.         
    
39.         boolstatus = swModelDocExt.SaveAs(PDFname, 0, 0, swExportPDFData, lErrors, lWarnings)
    
40. 
    
41.     Next i
    
42. 
    
43. End Sub
    

复制代码

该贴已经同步到 o1ojacko1o的微博

楠柠檬、

o1ojacko1o

楠柠檬、

口风琴

羊三丫

gdzsh

xl8310