8 Replies Latest reply on May 30, 2016 9:39 AM by Arthur McRae

    Userform auto close

    Arthur McRae

      Working on a Macro that has several Userforms.

      I can find how to have an auto closing Userform for excel but it isn't working for soldiworks.

      I'm finding code like this:

      Sub show_UserForm()

      Application.OnTime Now + TimeValue("00:00:15"), "close_UserForm"


      End Sub


      Sub close_UserForm()

      Unload UserForm1

      End Sub


      Private Sub UserForm_Activate()

        Application.Wait = (Now + TimeValue("0:00:30"))

        Sheet1.Cells(1, 1) = "Yes"

        Unload Me

      End Sub

      But I can't get it to run with solidworks Macros

        • Re: Userform auto close
          Deepak Gupta

          Try these


          Unload UserForm1

          • Re: Userform auto close
            Arthur McRae

            I've been in contact with API support. The userform timer functionality i was looking for, while available in excel and ms word, is not included in the SW libaray.  Their response was this:

            What we need is a timer event based library for VBA


            Once the timer event functionality is available then we need to also need keyboard and mouse event handling.


            Here is general algorithm

            1] when  form is displayed, start timers 2] in mouse and keyboard events reset timer 3] on timer end close form


            Currently the timer functionality  is not available.

            So basically not possible.

              • Re: Userform auto close
                Arthur McRae

                Our company has a foler heirarchy of where files are supposed to go, Model file, DXF file, BOM file etc.

                So everytime I save a PDF I have to traverse the heiarachy to the "Published" folder, this macro saves the drawing out as a PDF in the correct file for me.

                Option Explicit

                Dim swApp           As SldWorks.SldWorks

                Dim swDoc           As SldWorks.ModelDoc2

                Dim swModelDocExt   As SldWorks.ModelDocExtension

                Dim swCustProp      As CustomPropertyManager



                Dim boolstatus      As Boolean

                Dim longstatus      As Long, longwarnings As Long

                Dim Prop_N()        As String

                Dim iReply          As String

                Dim saveDir         As String, FileDir As String, FileName As String, sRev As String, sP_Numb As String, sStatus As String

                Dim FileExt(1 To 2) As String

                Dim FileChk         As Boolean






                Sub main()



                Set swApp = Application.SldWorks

                Set swDoc = swApp.ActiveDoc

                'check that a File is open

                If swDoc Is Nothing Then

                iReply = "No File open"

                MsgBox iReply


                End If

                Set swModelDocExt = swDoc.Extension

                Set swCustProp = swModelDocExt.CustomPropertyManager("")


                Prop_N() = Split("Status, PROJECT NO, Revision, CheckedBy, Description", ", ")


                'iReply = "WARNING! Macro underdevelopment"

                'MsgBox iReply



                'Checks to make sure current file is a drawing

                If swDoc.GetType <> swDocDRAWING Then

                MsgBox "Warning, File not Drawing!"

                sRev = 1


                Dim I As Integer

                Dim val As String, valout As String

                For I = 0 To UBound(Prop_N)

                boolstatus = swCustProp.Get4(Prop_N(I), False, val, valout)

                'Debug.Print "Value:                    " & val

                'Debug.Print "Evaluated value:          " & valout

                'Debug.Print "Up-to-date data:          " & boolstatus

                Select Case I

                        Case 0

                        sStatus = valout

                        Case 1

                        sP_Numb = valout

                        Case 2

                        sRev = valout

                        Case 3

                        If valout <> " " Or valout <> "" Then

                        Debug.Print "Checked by:                " & valout

                        FileChk = True


                        FileChk = False

                        End If

                        Case 4

                        Debug.Print "Description:               " & valout

                        Case Else

                        MsgBox "Unrecognized Property"

                End Select

                Next I

                End If

                'set up file extensions

                FileExt(1) = ".pdf"

                FileExt(2) = ".edrw"

                'Gets current file name and path

                FileName = swDoc.GetPathName

                Debug.Print FileName

                'strips solidworks extension off name and replaces with pdf

                FileDir = Left(FileName, Len(FileName) - 7)

                If InStr(FileDir, "Model") = 0 Then

                saveDir = Left(FileDir, InStrRev(FileDir, "\"))

                Else: saveDir = Left(FileDir, InStr(FileDir, "Model") + 5) & "\Published\"

                End If

                FileName = Right(FileDir, Len(FileDir) - InStrRev(FileDir, "\"))



                'Revison format

                If sRev = CStr("1") Or sRev = "" Then

                sRev = ""


                sRev = "_R" & sRev

                End If



                'Project Number Format

                sP_Numb = Mid(sP_Numb, 2, 5)

                If IsNumeric(sP_Numb) = True Then

                sP_Numb = "P" & sP_Numb

                    If InStr(FileName, sP_Numb) = 0 Then

                    FileName = sP_Numb & "_" & FileName

                    End If


                sP_Numb = ""

                End If



                'save loop

                For I = 1 To 2

                ' File checked Msg

                If sStatus = "FOR FAB" And FileChk <> True Then

                MsgBox "File not checked."

                End If



                boolstatus = FileSave(saveDir, FileName, sRev, FileExt(I))

                If sStatus <> "FOR FAB" Then

                Exit For

                End If

                Next I



                End Sub





                Function FileSave(DIR As String, NAME As String, REV As String, EXT As String)

                Application.SldWorks.ActiveDoc.Extension.SaveAs DIR & NAME & REV & EXT, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, longstatus, longwarnings

                'Debug.Print "Error: " & longstatus & vbNewLine & "Warning: " & longwarnings

                End Function

                • Re: Userform auto close
                  Deepak Gupta

                  Do you need the timer for closing the userform only?


                  Have you tried the SLEEP function?