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:
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.