改图纸格式+属性+存PDF+打印=180606

Dim sw全名, 另存全名 As String
Dim a, b  As String
Dim 拟转格式, 拟生成文件夹, SheetName As String
Dim 当前行
Sub 另存为其他格式(ByVal 拟转格式)
    '拟转格式 = "dwg"
    拟生成文件夹 = Range("A4") & "\" & 拟转格式
    If "" <> Dir(拟生成文件夹, 16) Then
        a = Format(Date, "yymmdd")   '当前年月日
        b = Format(Time, "hhmmss")     '当前时间
        拟生成文件夹 = 拟生成文件夹 & "=" & a & "." & b
    End If
    VBA.MkDir (拟生成文件夹)

    If 拟转格式 = "dwg" Then MsgBox "先设置好转换选项,再继续!", vbInformation
'    Call sw初始化("")
    Set SwApp = CreateObject("SldWorks.Application") '启动SW
    If 拟转格式 = "png" Then
        boolstatus = SwApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffPrintDPI, 400)
    End If

获取行列号
文件个数 = 1
Set 映射字典 = CreateObject("scripting.dictionary")
For 当前行 = 首行 To 末行
    Cells(当前行, 文件路径列号).Select
'If ActiveCell.Interior.ColorIndex = "-4142" Or ActiveCell.Interior.ColorIndex = "10" Then
If ActiveCell.Interior.ColorIndex = "-4142" Then '只处理无填充色的行==开始
    If 文件个数 > 3 Then swModel.Visible = False '隐藏掉上一个api打开的文件
    
    sw全名 = Cells(当前行, 文件路径列号) & Cells(当前行, 文件名称列号)
    Call sw初始化(sw全名)
    
    SheetName = Cells(当前行, 图纸名称列号)
    图纸总数 = swModel.GetSheetCount
    If 图纸总数 > 1 Then
        另存全名 = 拟生成文件夹 & "\" & FilenameWHZ & "-" & SheetName & "." & 拟转格式
    Else
        另存全名 = 拟生成文件夹 & "\" & FilenameWHZ & "." & 拟转格式
    End If
    
    bRet = swModel.ActivateSheet(SheetName)
    Set ExportData = Nothing
    Select Case 拟转格式
    Case "png"
        映射字典.RemoveAll
        Call sw常量映射(映射字典)
        For Each k In 映射字典("俗称tosw")
            Debug.Print k & "==" & 映射字典("俗称tosw")(k)
        Next
        sw图纸大小 = 映射字典("俗称tosw")(Cells(当前行, 图纸大小列号).Value)
        boolstatus = SwApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffPrintPaperSize, sw图纸大小)
    Case "PDF"
        Dim swExportPDFData     As SldWorks.ExportPdfData
        Set swExportPDFData = SwApp.GetExportFileData(1)
'        Dim strSheetName(0)     As String
'        strSheetName(0) = SheetName
        swExportPDFData.ViewPdfAfterSaving = False
        boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, SheetName)
        Set ExportData = swExportPDFData
    End Select
    
    boolstatus = swModel.Extension.SaveAs(另存全名, 0, 0, ExportData, lErrors, lwarnings)
    If bRet Then
'        Cells(当前行, 文件路径列号).Interior.ColorIndex = 4
    End If
    文件个数 = 文件个数 + 1
End If '只处理无填充色的行==结束
Next
'MsgBox "done!", vbInformation
End Sub
Sub 转图片作废()
    拟转格式 = "png"
    Call 生成文件夹
    
    Call sw初始化("")
    激活窗口
    boolstatus = SwApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffPrintPaperSize, swDwgPaperSizes_e.swDwgPaperA3size)
    boolstatus = SwApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffPrintDPI, 400)
    另存全名 = FilePath & "kk.PNG"
    boolstatus = swModel.Extension.SaveAs(另存全名, 0, 0, Nothing, lErrors, lwarnings)
    
End Sub