SolidWorks*Excel+VBA-缩略图,淦!

Sub ModelPreViews(RunMethod As String) '查看缩略图Dim swApp As SldWorks.SldWorks, SwMacro As StringOn Error Resume Next    Set swApp = GetObject(, "SldWorks.Application")    If swApp Is Nothing Then        MsgBox "请先打开SolidWorks！", vbExclamation, "不正经的机械仙人"        Exit Sub    End If    SwMacro = ThisWorkbook.Path & "\GetPreView.swp"    If PreViewForm.Visible = True Then        If RunMethod = "Events" Then swApp.RunMacro SwMacro, "Macro11", "ModelPreViews"    Else        ModelPreViews_Next "", "标题"        PreViewForm.Show (0)    End If    Set swApp = NothingEnd SubSub ModelPreViews_Next(P As String, Tit As String) '从SW端回传刷新数据    PreViewForm.Image1.Picture = LoadPicture(P)    PreViewForm.Label1.Caption = TitEnd Sub

Sub ModelPreViews() '查看缩略图Dim swApp As SldWorks.SldWorks, pic As StdPicture, xlapp As ObjectDim SwModel As String, regkey As String, filepath As String    Set swApp = Application.SldWorks    Set xlapp = GetObject(, "Excel.Application")    regkey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & xlapp.Version & "\Excel\Options\SwModel"    SwModel = myregedit(regkey, "", "", "R")    filepath = swApp.GetCurrentMacroPathFolder    Set pic = swApp.GetPreviewBitmap(SwModel, "默认")    If pic Is Nothing Then        xlapp.Run "'" & filepath & "\SW-File Systerm.xlsm'!ModelPreViews_Next", "", "标题"    Else        stdole.SavePicture pic, filepath & "\PreView.jpg"        xlapp.Run "'" & filepath & "\SW-File Systerm.xlsm'!ModelPreViews_Next", filepath & "\PreView.jpg", SwModel    End If    Set pic = Nothing    Set swApp = Nothing    Set xlapp = NothingEnd Sub

Function myregedit(mykey As String, myval As Variant, mytype As String, mymod As String) As VariantDim oWshell    Set oWshell = CreateObject("WScript.Shell")    Select Case True        Case mymod = "R" '读            myregedit = oWshell.RegRead(mykey)        Case mymod = "W" '写            oWshell.RegWrite mykey, myval, mytype        Case mymod = "D" '删            oWshell.RegDelete mykey    End Select    Set oWshell = NothingEnd Function