SaveAs4和SaveAs2生成PDF文件时，SolidWorks不响应的问题。

全潞福兵

测试以下两个语句，都出现下图问题，solidworks不响应。
SwModel.SaveAs2 PDFFile, 0, True, False
Debug.Print SwModel.SaveAs4(PDFFile, 0, 0, E, W)

• 
  
• 
  
• Private Sub PrintPDF()
  
• Dim Xls As Excel.Application, Rng As Range
  
• Set Xls = Application
  
• Set Rng = Xls.Selection
  
• 'Debug.Print Rng.Address
  
• 
  
• Dim R1 As Range, R2 As Range, R3 As Range, R4 As Range, R5 As Range, R6 As Range
  
• Set R1 = Xls.Range(Rng(1, 1))
  
• Set R2 = Xls.Range(Rng(2, 1))
  
• Set R3 = Xls.Range(Rng(3, 1))
  
• Set R4 = Xls.Range(Rng(4, 1))
  
• Set R5 = Xls.Range(Rng(5, 1))
  
• Set R6 = Xls.Range(Rng(6, 1))
  
• ''
  
• Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
  
• 
  
• 
  
• 'Set SwModel = SwApp.ActiveDoc
  
• Dim E As Long, W As Long, PDFFile
  
• 
  
• For ii = 1 To R5.Rows.Count
  
• Set SwApp = CreateObject("SldWorks.Application")
  
• 
  
• SwApp.Visible = True
  
• Set SwModel = SwOpenFile(SwApp, R5(ii, 1))
  
• PDFFile = R6(ii, 1)
  
• Debug.Print SwModel.SaveAs4(PDFFile, 0, 0, E, W)
  
• Debug.Print ii, PDFFile
  
• SwModel.SaveAs PDFFile
  
• SwApp.CloseDoc SwModel.GetTitle
  
• SwApp.ExitApp
  
• Next ii
  
• Dim PDFRng As Range, MergePDF
  
• 
  
• Set PDFRng = R6 '.Resize(2, R6.Columns.Count)
  
• MergePDF = Rng(0, 3)
  
• RngMergePDF PDFRng, MergePDF
  
• 
  
• 
  
• End Sub
  
• 
  
• ''
  
• Private Sub testMergePDF()
  
• Dim Xls As Excel.Application, Rng As Range
  
• Set Xls = Application
  
• Set Rng = Xls.Selection
  
• 'Debug.Print Rng.Address
  
• 
  
• Dim R1 As Range, R2 As Range, R3 As Range, R4 As Range, R5 As Range, R6 As Range
  
• Set R1 = Xls.Range(Rng(1, 1))
  
• Set R2 = Xls.Range(Rng(2, 1))
  
• Set R3 = Xls.Range(Rng(3, 1))
  
• Set R4 = Xls.Range(Rng(4, 1))
  
• Set R5 = Xls.Range(Rng(5, 1))
  
• 
  
• Set R6 = Xls.Range(Rng(6, 1))
  
• Dim PDFRng As Range, MergePDF
  
• Set PDFRng = R6.Resize(3, R6.Columns.Count)
  
• MergePDF = Rng(0, 3)
  
• RngMergePDF PDFRng, MergePDF
  
• End Sub
  

复制代码

黎国侨

saveas、saveas2、saveas4等需要了解细节，应用场合需要搞清。

wenzi8411

Option Explicit
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swModelDocExt       As SldWorks.ModelDocExtension
    Dim swExportData          As SldWorks.ExportPdfData
    Dim boolstatus          As Boolean
    Dim filename            As String
    Dim textdate            As String
    Dim lErrors             As Long
    Dim lWarnings           As Long
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "No current document", vbCritical
        End
    End If
    If swModel.GetType <> swDocDRAWING Then
        MsgBox &quot;This Macro only works on Drawings&quot;, vbCritical
        End
    End If
    Set swModelDocExt = swModel.Extension
    Set swExportData = swApp.GetExportFileData(swExportPDFData)
    filename = swModel.GetPathName
    If filename = &quot;&quot; Then
        MsgBox &quot;Please save the file first and try again&quot;, vbCritical
        End
    End If
    textdate = Format(Date, &quot;yyyy-mm-dd&quot;)
    filename = Strings.Left(filename, Len(filename) - 6) & textdate & &quot;.PDF&quot;
    boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
    swExportData.ViewPdfAfterSaving = True
    boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)
    If boolstatus Then
        MsgBox &quot;Save as PDF successful&quot; & vbNewLine & filename
    Else
        MsgBox &quot;Save as PDF failed, Error code:&quot; & lErrors
    End If
End Sub
引用其他人编写的宏，自己乱加了一些东西，仅供参考

wangyanpin

swModelDocExt.SaveAs，一般都是用这个命令来保存为其他格式。把文件的后缀名改一下就好，然后用swModelDocExt.SaveAs