Search code examples
vbatextboxuserformsolidworksgroupname

Group Textboxes to create an array in VBA

I want to automatically save solidworks files within an assembly. The names of each parts that will be saved is created based on the input given in a userform.

The user can determine the amount and what parts to save. This code is used to create an array of the parts;

Dim Control As Control, ArrayParts As String
For Each Control In Me.Controls
If TypeName(Control) = "CheckBox" Then
    If Control.Value Then
        ArrayParts = IIf(ArrayParts <> "", ArrayParts & ",", "") & Control.Caption
    End If
End If
Next

Below the accessory Userform:

enter image description here

If the user selects parts (in this case 2 parts), then these 2 parts are saved that looks a bit like the following:

For i = LBound(ArrayList) To UBound(ArrayList)
  finalName = PathCut & "XT\" & partcode & " " & ArrayList(i) & " " & REVCode & Extension
  swModelToExport.Extension.SaveAs3 finalName, 0, 1, Nothing, Nothing, nErrors, nWarnings
Next

The output of a part can be ".....XT\123 Part1 1.X_T Where the partcode and REVCode are determined in the userform. ArrayList contains the parts

At the moment, all parts have the same "REV code". However, I want the user to be able to manually adapt the REV code per part. So if part 1 is selected, then the value of textbox "txtREV1" will be used to name the part. My question is that I'm not sure how to implement this in my code. I wanted to use the same method as I did to my "ArrayParts", but I don't want to select ALL my textboxes as controls, only the ones that appear next to the parts on my userform. I tried to group the textboxes, but there is no Groupname Property tab for textboxes, only for checkboxes as far as I can see. Any tips are welcome. Thank you

EDIT: MY USERFORM

Private Sub UserForm_Initialize() 'As soon as form opens
    optbtnXT.Value = True 'Sets XT button as default in case these options are neglected by the user
    EnableButtonCheck 'Check if fields are (not) empty
    
    txtboxREV1.Visible = False
    txtboxREV2.Visible = False
    txtboxREV3.Visible = False
    txtboxREV4.Visible = False
    txtboxREV5.Visible = False
    txtboxREV6.Visible = False
    txtboxREV7.Visible = False
    txtboxREV8.Visible = False
    
End Sub

'COMMANDBUTTON
'---------------------------------------------------------------------------
Private Sub CmdBtnUserParam_Click()

    'SELECT PARTS TO BE SAVES (CHECKBOX)
    '---------------------------------------------------------------------------
    'Check which checkboxes CAPTIONS are selected ans save in the array called ArrayParts
    Dim Control As Control, ArrayParts As String
    For Each Control In Me.Controls                                     '"Me" refers to the current userform. Can also be replaced by "UserParam"
    If TypeName(Control) = "CheckBox" Then
        If Control.Value Then 'This is on a different line to prevent errors, VB checks all conditions of an If even if first one is false.
            ArrayParts = IIf(ArrayParts <> "", ArrayParts & ",", "") & Control.Caption
        End If
    End If
    Next
    Debug.Print "ArrayParts = ", ArrayParts
        
        '---------------------------------------------------------------------------
    'Check which checkboxes NAMES are selected ans save in the array called ArrayNumbers
    Dim ArrayNumbers As String
    For Each Control In Me.Controls                                     '"Me" refers to the current userform. Can also be replaced by "UserParam"
    If TypeName(Control) = "CheckBox" Then
        If Control.Value Then 'This is on a different line to prevent errors, VB checks all conditions of an If even if first one is false.
            ArrayNumbers = IIf(ArrayNumbers <> "", ArrayNumbers & ",", "") & Control.Name
        End If
    End If
    Next
    Debug.Print "ArrayNumbers = ", ArrayNumbers
               
    'TYPE OF EXTENSION (OPTIONBOX)
    '---------------------------------------------------------------------------
    Dim OptionExtension As String
    
    If optbtnStep.Value = True Then
        OptionExtension = ".STEP"
    ElseIf optbtnXT.Value = True Then
        OptionExtension = ".X_T"
    Else
        UserParam.Hide
        MsgBox "Please select an extension type"
        UserParam.Show
    End If
    
    'MOLD- AND REV CODE (TEXTBOXES)
    '---------------------------------------------------------------------------
    'Declare variables
    Dim MoldCodeFS As String
    Dim MoldCodeMS As String
    Dim REVCodeNR As String
    
    'Set codes is equal to the text in the textboxes
    MoldCodeFS = txtboxMoldCodeFS.Text
    MoldCodeMS = txtboxMoldCodeMS.Text
    REVCodeNR = txtboxREVcode.Text

    'SAVE PARAMETERS AND SEND TO MAIN SUB
    '---------------------------------------------------------------------------
    'Call the UserInput subroutine to enter the variables
    Call UserInput(MoldCodeFS, MoldCodeMS, REVCodeNR, CheckFS, CheckMS, OptionExtension, ArrayParts, ArrayNumbers)
    
    'End the macro
    End
    
End Sub


'TEXTBOXES
'---------------------------------------------------------------------------
Private Sub txtboxMoldCodeFS_Change()
    If Not IsNumeric(UserParam.txtboxMoldCodeFS.Value) Then
          UserParam.Hide
          msg = MsgBox("Please enter a numeric value", vbOKOnly)
          UserParam.Show
    End If

     UserParam.txtboxMoldCodeMS.Value = (Me.txtboxMoldCodeFS.Value) + 1 'Copies the numbers from FS page and adds 1
     EnableButtonCheck 'Check if fields are (not) empty
End Sub


Private Sub txtboxMoldCodeMS_Change() 'If a three numbered code it entered in MS Code, then automatically move to the REV code textbox
    If txtboxMoldCodeMS.TextLength = 3 Then
        txtboxREVcode.SetFocus
    End If
    
    If Not IsNumeric(UserParam.txtboxMoldCodeMS.Value) Then
        UserParam.Hide
        msg = MsgBox("Please enter a numeric value", vbOKOnly)
        UserParam.Show
    End If
    
    EnableButtonCheck 'Check if fields are (not) empty
End Sub


Private Sub txtboxREVcode_AfterUpdate() 'Makes sure the REV code only contains numerical values
    If Not IsNumeric(UserParam.txtboxREVcode.Value) Then
          UserParam.Hide
          msg = MsgBox("Please enter a numeric value", vbOKOnly)
          UserParam.Show
    End If
    
End Sub

Private Sub txtboxREVcode_Change()
    If Not IsNumeric(UserParam.txtboxREVcode.Value) Then
          UserParam.Hide
          msg = MsgBox("Please enter a numeric value", vbOKOnly)
          UserParam.Show
    End If
    EnableButtonCheck 'Check if fields are (not) empty
    
    Me.txtboxREV1 = Me.txtboxREVcode.Text
    Me.txtboxREV2 = Me.txtboxREVcode.Text
    Me.txtboxREV3 = Me.txtboxREVcode.Text
    Me.txtboxREV4 = Me.txtboxREVcode.Text
    Me.txtboxREV5 = Me.txtboxREVcode.Text
    Me.txtboxREV6 = Me.txtboxREVcode.Text
    Me.txtboxREV7 = Me.txtboxREVcode.Text
    Me.txtboxREV8 = Me.txtboxREVcode.Text
    
    
End Sub

'CHECKBOXES
'---------------------------------------------------------------------------
'FS

Private Sub Part1_Click()
    If Part1 = True Then
    txtboxREV1.Visible = True
    txtboxREV1.Enabled = True
    Else
    txtboxREV1.Visible = False
    End If
End Sub

Private Sub Part2_Click()
    If Part2 = True Then
    txtboxREV2.Visible = True
    txtboxREV2.Enabled = True
    Else
    txtboxREV2.Visible = False
    End If
End Sub

Private Sub Part3_Click()
    If Part3 = True Then
    txtboxREV3.Visible = True
    txtboxREV3.Enabled = True
    Else
    txtboxREV3.Visible = False
    End If
End Sub

Private Sub Part4_Click()
    If Part4 = True Then
    txtboxREV4.Visible = True
    txtboxREV4.Enabled = True
    Else
    txtboxREV4.Visible = False
    End If
End Sub

'MS
Private Sub Part5_Click()
    If Part5 = True Then
    txtboxREV5.Visible = True
    txtboxREV5.Enabled = True
    Else
    txtboxREV5.Visible = False
    End If
End Sub

Private Sub Part6_Click()
    If Part6 = True Then
    txtboxREV6.Visible = True
    txtboxREV6.Enabled = True
    Else
    txtboxREV6.Visible = False
    End If
End Sub

Private Sub Part7_Click()
    If Part7 = True Then
    txtboxREV7.Visible = True
    txtboxREV7.Enabled = True
    Else
    txtboxREV7.Visible = False
    End If
End Sub

Private Sub Part8_Click()
    If Part8 = True Then
    txtboxREV8.Visible = True
    txtboxREV8.Enabled = True
    Else
    txtboxREV8.Visible = False
    End If
End Sub

'OTHER
'---------------------------------------------------------------------------
Sub EnableButtonCheck() 'Only enables button if fields are not empty
    Me.CmdBtnUserParam.Enabled = CBool(Me.txtboxMoldCodeFS.Value <> "" And _
    Me.txtboxMoldCodeMS.Value <> "" And Me.txtboxREVcode.Value <> "")
End Sub

'https://stackoverflow.com/questions/78922628/group-textboxes-to-create-an-array-in-vba/78922931?noredirect=1#comment139266603_78922931 @Created
Public Function getREV(UF As Object, txtPart As String) As String
  Dim c As Control, nOPart As Long
  Const refRoot As String = "txtboxREV" 'Prefix without the numbers!

  With CreateObject("vbscript.regexp")
        .Pattern = "\d{1,2}?.*$"
        .Global = False
        nOPart = .Execute(txtPart)(0)
    End With
  For Each c In UF.Controls
    If TypeName(c) = "TextBox" Then
        If c.Name = refRoot & nOPart Then getREV = c.Text: Exit For
    End If
  Next c
End Function

My MAIN SUB:

' ***********************************************************************************************************************
' Script to automatically save files. ***********************************************************************************************************************
Option Explicit 'Forces to declare all used variables

'Declare variables
Dim swApp                As SldWorks.SldWorks
Dim swModelActivated     As SldWorks.ModelDoc2
Dim swModelToExport      As SldWorks.ModelDoc2
Dim strModelName         As String
Dim nStatus              As Long
Dim nErrors              As Long
Dim nWarnings            As Long
Dim Part                 As Object
Dim SelMgr               As Object
Dim boolstatus           As Boolean
Dim longstatus           As Long, longwarnings As Long
Dim Feature              As Object
Dim Step                 As Long
Dim PathInit, PathCut    As String
Dim instance             As ISldWorks

Sub SaveFiles()

    'Use opened assembly as active document
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
    
    'Prepare path
    PathInit = Part.GetPathName                         'Determine file location of the assembly
    PathCut = Left(PathInit, InStrRev(PathInit, "\"))   'Remove text "Assembly.SLDASS" after the last slash
        
    'Create "XT" folder if it does not exist
    Dim strDir, FolderName As String
    FolderName = "\XT"                                  'Change in case different foldername is desired
    strDir = PathCut & FolderName
    If Dir(strDir, vbDirectory) = "" Then               'If directory does not exist, then
        MkDir strDir                                    'MkDir makes new directory
    End If
    
    'Open user form
    UserParam.Show
    
End Sub

Public Sub UserInput(InputMldPartNrFS, InputMldPartNrMS, InputREVCodeNr, InputCheckBxFS, InputCheckBxMS, OptionExtension, InputArrayParts, InputArrayNumbers As String)
    Dim MldPartNrFS, MldPartNrMS, REVCodeNR, CheckBxFS, CheckBxMS As String
    Dim ArrayList As Variant
    Dim ArrayPartNumbers As Variant
    Dim ExtInit, ExtNew, PartNameFS, ProjectNr, XTFolder, REV  As String
    Dim PartNr, initName As String
    Dim SavePart As Variant
    Dim i As Integer
    Dim OutputCoordSys As String
    Dim FileToExport As String
    Dim StepFile As String
    Dim finalName As String
    Dim finalNameCut As Variant
    Dim strModelName As String
    Dim swModel As SldWorks.ModelDoc2
    Dim mldpartcode As String
    
    'Parameters
    OutputCoordSys = "Coordinate System1"
    
    'Create new pathname
    ExtInit = ".SLDPRT"                         'Old extension
    ExtNew = OptionExtension                    'Input from userform: either X_T or STEP
    MldPartNrFS = InputMldPartNrFS              'Input from userform
    MldPartNrMS = InputMldPartNrMS              'Input from userform
    REVCodeNR = "[REV" + InputREVCodeNr + "]"   'Input from userform
    ArrayList = Split(InputArrayParts, ",")
    ArrayPartNumbers = Split(InputArrayNumbers, ",")
    Debug.Print "InputArrayParts = ", InputArrayParts
    
    Debug.Print "LALALAL = ", ArrayPartNumbers(0)
    
    For i = LBound(ArrayList) To UBound(ArrayList) 'Run loop x times depending on the amount of selected checkboxes in the userform
        
        'Assign code number on either FS or MS parts
        Select Case ArrayList(i)
          Case "Fixed side", "Mounting plate FS", "12 mm_ejector plate FS", "Cover plate FS"        'If part contains these names
          mldpartcode = MldPartNrFS                                                                 'Then assign the code for FS
        Case Else                                                                                   'If the names are not as written above
          mldpartcode = MldPartNrMS                                                                 'Then assign the code for MS
        End Select
                
        'Change Array names so that "12 mm_ejector plate FS" will be saved as "Ejector plate FS"
        Dim ArrayListAdapted As String
        ArrayListAdapted = Replace(Replace(ArrayList(i), "12 mm_ejector plate FS", "Ejector plate FS"), "12 mm_ejector plate MS", "Ejector plate MS")
        Dim REVREV As Variant
        'REVREV = UserParam.getREV(UserParam, UserParam.ArrayPartNumbers(0))
        'Debug.Print "REVREV = "", REVREV"
               
        initName = PathCut + ArrayList(i) + ExtInit
        'finalName = PathCut & "XT\" & NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & REVCodeNR & ExtNew
        'finalNameCut = NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & REVCodeNR & ExtNew
        finalName = PathCut & "XT\" & NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & getREV(UserParam, CStr(ArrayPartNumbers(0))) & ExtNew
        finalNameCut = NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & getREV(UserParam, CStr(ArrayPartNumbers(0))) & ExtNew
        'Debug.Print "TESTREV", UserParam.getREV(UserParam, ArrayPartNumbers) 'instead of UserForm4 use your real form name...
        'Debug.Print "ArrayPartNumbers = ", ArrayPartNumbers(i)
        
        'Debug.Print "PART ONE = ", UserParam.getREV(UserParam, ArrayPartNumbers(0))
        Debug.Print "ArrayPartNumbers = ", ArrayPartNumbers(0)
        
        'Open and activate the correct model
        Set swModel = swApp.OpenDoc6(initName, 1, 0, "", nStatus, nWarnings)                                                'Open the model
        Set swModelActivated = swApp.ActivateDoc3(initName, False, swRebuildOnActivation_e.swUserDecision, nErrors)         'Activate the model
        Set swModelToExport = swApp.ActiveDoc                                                                               'Get the activated model
        Debug.Print "strModelName = ", strModelName
        
        'Define correct settings
        swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepAP, 214                                    'Assign the correct STEP file
        swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExportAppearances, True                                'Set the export appearences option to true
        swApp.SetUserPreferenceStringValue swUserPreferenceStringValue_e.swExportOutputCoordinateSystem, OutputCoordSys     'Assign output coordinate system
        
        'Save the file if it does not exist yet
        Dim FileNameOverwrite
        Dim IsToBeSaved
        IsToBeSaved = True
        
        If Not Dir(finalName, vbDirectory) = vbNullString Then
            FileNameOverwrite = MsgBox("Filename " & finalNameCut & " already exists. Do you want to overwrite?", vbQuestion + vbYesNoCancel, "File overwrite")
            UserParam.Hide
            If FileNameOverwrite = vbNo Then
                UserParam.Show
                IsToBeSaved = False
                'Exit Sub ' Stop the code execution, no more looping
            End If
            If FileNameOverwrite = vbCancel Then
                UserParam.Show
                Exit Sub
            End If
        End If
        
        If IsToBeSaved Then
            swModelToExport.Extension.SaveAs3 finalName, 0, 1, Nothing, Nothing, nErrors, nWarnings
        End If
        
        'swModelToExport.Extension.SaveAs3 finalName, 0, 1, Nothing, Nothing, nErrors, nWarnings
        swApp.CloseDoc ArrayList(i) & ".SLDPRT" 'Close all the files
         
        'Reopen assembly
        Set swModel = swApp.OpenDoc6(PathInit, 1, 0, "", nStatus, nWarnings)                                                    'Open the model
        Set swModelActivated = swApp.ActivateDoc3(PathInit, False, swRebuildOnActivation_e.swUserDecision, nErrors)             'Activate the model
        Set swModelToExport = swApp.ActiveDoc                                                                                   'Get the activated model
    Next
               
End Sub

'https://stackoverflow.com/questions/78821220/select-value-from-path-to-save-file-using-vba/78821411?noredirect=1#comment138991489_78821411
Function NumPart(initName As String) As String
  Dim FileName As String, FoldPath As String, arr, arrEl, El
  Dim newFileName As String, fileNoExtention As String
  
  arr = Split(initName, "\")
  For Each El In arr
    arrEl = Split(El, "_")
    If UBound(arrEl) = 2 Then
        If IsNumeric(arrEl(1)) Then
            NumPart = arrEl(1): Exit For
        End If
    End If
  Next El
  
End Function
Solution

  • You did not answer my clarification question...

    But supposing that my assumptions are correct (there is a correlation between the numeric part of the check boxes, separated by space from the alpha numeric part) you need the next function, able to extract the correspondent text box vale:

    private Function getREV(UF As Object, txtPart As String) As String
  Dim c As Control, nOPart As Long
  Const refRoot As String = "txtREV" 'use here your real text box naming prefix!
  nOPart = Split(txtPart)(1) 'extract the numeric part
  For Each c In UF.Controls
    If TypeName(c) = "TextBox" Then
        If c.Name = refRoot & nOPart Then getREV = c.text: Exit For
    End If
  Next c
End Function

    And having it in the form module, you can define the necessary path as:

    finalName = PathCut & "XT\" & partcode & " " & ArrayList(i) & " " & getREV(Me, CStr(ArrayList(0))) & Extension

    I used the first function parameter only to test it from a standard module, after showing the form, ticking some check boxes and filling the REV text boxes. Something like:

    Sub testgetRev()
   Debug.Print getREV(UserForm4, "Part 1") 'instead of UserForm4 use your real form name...
End Sub

    Of course, the function must also exist in the respective standard module. Or make it public in the user form and call it from there. Something like:

    Sub testgetRev()
   Debug.Print UserForm4.getREV(UserForm4, "Part 1") 'Of course, UserForm4 must be your real form name...
End Sub

    You can also do that allocating an eloquent tag to the respective text boxes and use it instead of their name.

    Edited:

    The next adapted function is able to extract ending number (1 to 3 characters), even if not separated by space (it works with spaces, too):

    Public Function getREV(UF As Object, txtPart As String) As String
  Dim c As Control, nOPart As Long
  Const refRoot As String = "txtREV"

  With CreateObject("vbscript.regexp")
        .Pattern = "\d{1,2}?.*$"
        .Global = False
        nOPart = .Execute(txtPart)(0)
    End With
  For Each c In UF.Controls
    If TypeName(c) = "TextBox" Then
        If c.Name = refRoot & nOPart Then getREV = c.text: Exit For
    End If
  Next c
End Function

    Please, test it and send some feedback.