也许这篇文章有点长,但我希望你能阅读它并为我提供一些意见。
我一直在努力为焊工资格测试记录(WQTR)制作一份用户表格。由于表单是107个字段,我创建了一个相当复杂的模块,允许用户保存他们的进度。而是键入冗长的解释,我在这里添加完成的模块。我已经在代码中做了详细的评论,但如果需要解释,请告诉我。
一切都编译得很好,它做了我期望它做的一个例外。我假设(不确定原因)脚本正在读取TextBox并将其输入工作表(一行中的所有内容)与Tab键顺序同步。但是,情况并非如此。事实上,我根本看不到任何特定的秩序。我认为这与我如何根据用户表单中的标签创建列的标题有关,但我不确定。即使我将所有标签的TabStop属性设置为False,我也确保标签在Tab键顺序中的顺序正确。
以下是我在模块中的代码。我还有其他几个模块,但没有一个模块可以解决这个问题。
Option Explicit
Dim ws As Worksheet
Dim welderNameEntered As String
Dim welderName_ As Variant
Dim welderFirstName As String
Dim welderMiddlename As String
Dim welderLastName As String
Dim sheetName As String
Dim arrayLength As Integer
'********************************************************************************
'***Controls the order of execution in this module for all Subs and Functions.***
'********************************************************************************
Public Sub TempSaveProgress()
Application.ScreenUpdating = False
Call SplitName
funcCheckAndAddNewSheet sheetName
Call SaveData
Call Protection.DangerMouse(sheetName)
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub
'************************************************************************************
'***Splits the Welders's first and last names by the space between them and grabs****
'***the first three characters of each. Sets the value of the sheetname variable***
'************************************************************************************
Sub SplitName()
welderNameEntered = WQTR_Form.welderNameText.Value
welderName_ = Split(welderNameEntered, " ")
Dim arrayLength As Integer
arrayLength = UBound(welderName_) - LBound(welderName_) + 1
Dim answer As Long
If arrayLength = 0 Then
Call ArrayLengthZero
Exit Sub
ElseIf arrayLength = 1 Then
Call ArrayLengthOneAndThree
Exit Sub
ElseIf arrayLength = 2 Then
welderFirstName = Left(welderName_(0), 3)
welderLastName = Left(welderName_(1), 3)
sheetName = "Temp-" + welderLastName + "-" + welderFirstName
ElseIf arrayLength = 3 Then
welderFirstName = Left(welderName_(0), 3)
welderMiddlename = Left(welderName_(1), 1)
welderLastName = Left(welderName_(2), 3)
sheetName = "Temp-" + welderLastName + "-" + welderFirstName + "-" + welderMiddlename
ElseIf arrayLength > 3 Then
Call ArrayLengthOneAndThree
Exit Sub
End If
End Sub
'**************************************************************************************
'***Adds and new worksheet after all other worksheets and gives it a temporary name.***
'**************************************************************************************
Function funcCheckAndAddNewSheet(argCheckAndAdd As String)
For Each ws In ThisWorkbook.Worksheets
If argCheckAndAdd = ws.Name Then
Call SheetNameAlreadyExists
End If
Next ws
If sheetName <> "" Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = argCheckAndAdd
End If
End Function
'*****************************************
'***Message if the arrayLength is zero ***
'*****************************************
Sub ArrayLengthZero()
Dim answer As Long
answer = MsgBox("You must enter a welder's name in order to Save Your Progress.", vbOKOnly, "No name?")
End Sub
'**************************************************
'***Message if the arrayLength is One or Three. ***
'**************************************************
Sub ArrayLengthOneAndThree()
Dim answer As Long
answer = MsgBox("The Welder's Name you entered is not valid. The name must conform to one these examples:" + _
vbNewLine + vbNewLine + _
" 1. FirstName LastName as in John Doe." + vbNewLine + _
" 2. FirstName MiddleName LastName as in Franklin Deleno Roosevilt." + vbNewLine + _
" 3. FirstName MiddleInitial LastName as in Joe D. Public." + vbNewLine + vbNewLine + _
"You also must make sure that names are no more than three names. " + _
"A name such as Roy Wayne David Johnson will not work. " + _
"In such cases, one of the two middle names must be omitted." _
, vbOKOnly, "Name is incorrect")
End Sub
'******************************************************************************
'***Message if sheetName matches the name of an already existing worksheet. ***
'******************************************************************************
Sub SheetNameAlreadyExists()
Dim answer As Long
answer = MsgBox("A WorkSheet by by the name " + sheetName + " already exists." + _
" Did you already Save Progress for this welder on another occasion?" + _
" If so, would you like to overwrite the data in the Worksheet named " + _
sheetName + "?", vbYesNo, sheetName + " Already Exists.")
If answer = vbYes Then
Call SafeMouse
Worksheets(sheetName).Activate
Application.DisplayAlerts = False
Worksheets(sheetName).Delete
Application.DisplayAlerts = True
Exit Sub
Else
Exit Sub
End If
End Sub
'****************************************************************************************
'***Sets the Active Sheet for all of the subs it calls. Again, this basically ***
'***controls the order of execution. Then does some minor worksheet level formatting. ***
'****************************************************************************************
Private Sub SaveData()
Worksheets(sheetName).Activate
Call LabelNames
Call LabelCaptions
Call TextBoxText
Call DeleteEmptyColumns
'-----Worksheet-level Formatting-----
Worksheets(sheetName).range("A1:DD1").Font.Bold = True
Worksheets(sheetName).Columns("A:DD").AutoFit
End Sub
'***************************************************************************************
'***Takes the names of all of the form lables and enters them in the first row of the***
'***active sheet. ***
'***************************************************************************************
Private Sub LabelNames()
Dim ctlLblName As control
Dim col As Integer: col = 0
For Each ctlLblName In WQTR_Form.Controls
If TypeName(ctlLblName) = "Label" Then
col = col + 1
Cells(1, col).Value = ctlLblName.Name
Cells(1, col).Interior.ColorIndex = 15
End If
Next ctlLblName
End Sub
'*******************************************************************************************
'***Takes the captions of all of the form lables and enters them in the second row of the***
'***active sheet. ***
'*******************************************************************************************
Private Sub LabelCaptions()
Dim ctlLblCaption As control
Dim col As Integer: col = 0
For Each ctlLblCaption In WQTR_Form.Controls
If TypeName(ctlLblCaption) = "Label" Then
col = col + 1
Cells(2, col).Value = ctlLblCaption.Caption
Cells(2, col).Interior.ColorIndex = 6
End If
Next ctlLblCaption
End Sub
'***************************************************************************************************
'***The Label Names and the TextBox Names were made to be identical except for the last part of ***
'***the names which are "Label" and "Text", respectively. This code finds all TextBox Names, ***
'***strips "Text" out of the TexBox Name and replaces it with "Label" which makes it identical ***
'***to the Label Name. Then it searches for the label name in the active sheet. When a match ***
'***found it inserts the TextBox.Text Value (entered by the user) in the cell in row three. ***
'***************************************************************************************************
Private Sub TextBoxText()
Dim ctlTxtBx As control
Dim col As Variant: col = 0
Dim strTextBoxName As String
Dim strShortenedTxtBxName As String
Dim strConvertedTxtBxName As String
For Each ctlTxtBx In WQTR_Form.Controls
If TypeName(ctlTxtBx) = "TextBox" Then
strTextBoxName = ctlTxtBx.Name
strShortenedTxtBxName = Left(strTextBoxName, Len(strTextBoxName) - 4)
strConvertedTxtBxName = strShortenedTxtBxName + "Label"
col = Application.Match(strConvertedTxtBxName, Worksheets(sheetName).Rows(1), 0)
col = CInt(col)
Cells(3, col).Value = ctlTxtBx.Text
End If
Next ctlTxtBx
End Sub
'******************************************************************************************************
'***Search columns from A through DF (110) and deletes columns where the cell in row three is empty.***
'******************************************************************************************************
Private Sub DeleteEmptyColumns()
Dim col As Integer
For col = 110 To 1 Step -1
If Cells(3, col) = "" Then
ActiveSheet.Columns(col).Delete
End If
Next col
End Sub
那么,基于Tab顺序,我所期望的是以下
'| welderNameLabel | testDateLabel | wqtrNumberLabel | shopLabel | companyNameLabel | revisionNumberLabel | wpsNumberLabel | bm1_specificationLabel |
'|---------------- | ------------- | --------------- | --------- | ---------------- | ------------------- | -------------- | ---------------------- |
'| Welder Name | Test Date | WQTR Number | Shop | Company Name | Revision Number | WPS Number | Specification |
'|---------------- | ------------- | --------------- | --------- | ---------------- | ------------------- | -------------- | ---------------------- |
'| Dean Marin | 5-23-2017 | DM-1234-6G-FCAW | Bravo | ABC Company | Rev. 0 | 12345 | AWS D1.1 Code |
我实际得到的是这样的:
'| testDateLabel | welderNameLabel | companyNameLabel | shopLabel | wqtrNumberLabel | revisionNumberLabel | wpsNumberLabel | bm1_specificationLabel |
'| ------------- | --------------- | ---------------- | --------- | --------------- | ------------------- | -------------- | ---------------------- |
'| Test Date | Welder Name | Company Name | Shop | WQTR Number | Revision Number | WPS Number | Specification |
'| ------------- | --------------- | ---------------- | --------- | --------------- | ------------------- | -------------- | ---------------------- |
'| 5-23-2017 | Dean Marin | ABC Company | Bravo | DM-1234-6G-FCAW | Rev. 0 | 12345 | AWS D1.1 Code |
我已经多次测试过它,它总是以完全相同的顺序将数据放入工作表中。我可以写一些代码来按照我想要的顺序对它进行排序但是在我这样做之前我想发布这个问题,看看是否有人对它为什么会这样做有任何想法。我有点担心我会写一些东西来排序列,然后发现我的实验有误导性,数据输入的顺序确实比它看起来更随机。
我的代码只是为用户表单中的每个TextBox写了一行代码,并明确指定了数据应该去的确切单元格,但我想要一些更通用的东西,我可以适应我计划的其他工作簿,因为它们都是相互关联的 - (焊接程序,程序资格和焊工资格连续性日志)。
也许有一些方法有人知道在输入数据之前控制这个顺序而不是在事后做某种排序操作?
我感谢任何回复。
更新和答案
我同意jsotola必须按照他们创建的顺序订购。 jsotola提供了一些列出订单的代码,我多次运行它,并且总是以完全相同的顺序得到完全相同的列表。
神秘解决了!
如果您有兴趣,请点击此处。我对答案如此强烈赞同的部分原因是,从记忆中,我可以说这是我将控件添加到表单的顺序。如果您浏览控件,您将看到名称的逻辑分组。在您阅读清单时,它们彼此相关。
bm1_tubeSizeText
bm1_pipeFrame
bm1_pipeDiameterLabel
bm1_pipeDiameterText
baseMetalFrame2
bm2_baseMetalListBox
bm2_specificationLabel
bm2_specificationText
bm2_awsGroupNumberText
bm2_awsGroupNumberLabel
bm2_gradeLabel
bm2_gradeText
bm2_plateFrame
bm2_plateThicknessLabel
bm2_plateThicknessText
bm2_tubeFrame
bm2_tubeWallThicknessLabel
bm2_tubeWallThicknessText
bm2_tubeSizeLabel
bm2_tubeSizeText
bm2_pipeFrame
bm2_pipeSizeLabel
bm2_pipeSizeText
bm2_pipeSheduleLabel
bm2_pipeSheduleText
bm2_pipeDiameterLabel
bm2_pipeDiameterText
actualTestValuesFrame
atv_TypeOfWeldJointText
atv_filletPipeDiameterText
atv_filletPipeDiameterLabel
atv_baseMetalLabel
atv_baseMetalText
atv_filletFrame
atv_filletPipeTubeThicknessLabel
atv_filletPipeTubeThicknessText
atv_filletPlateThicknessLabel
atv_filletPlateThicknessText
atv_weldingFrame
atv_processLabel
atv_processText
atv_TypeOfWeldJointLabel
atv_grooveFrame
atv_groovePipeTubeThicknessLabel
atv_groovePipeTubeThicknessText
atv_groovePlateThicknessLabel
atv_groovePlateThicknessText
atv_groovePipeDiameterLabel
atv_groovePipeDiameterText
atv_processTypeLabel
atv_processTypeText
atv_backingLabel
atv_backingText
atv_weldingProcessFrame
atv_InstructionLabel_1
atv_InstructionLabel_2
atv_fillerMetalFrame
atv_awsSpecLabel
atv_awsSpecText
atv_awsClassificationLabel
atv_awsClassificationText
atv_fNumberLabel
atv_fNumberText
atv_positionFrame
atv_positionWeldedLabel
atv_positionWeldedText
rq_transferModeLabel
rq_transferModeText
rq_progressionLabel
rq_progressionText
atv_InstructionLabel_3
rq_InstructionLabel_4
rq_InstructionLabel_5
rq_singleOrMultipleElectrodesLabel
rq_singleOrMultipleElectrodesText
rq_gasFluxTypeLabel
rq_gasFluxTypeText
rangesQualiifedFrame
rq_weldingFrame
rq_weldingProcessFrame
rq_processLabel
rq_processText
rq_processTypeLabel
rq_processTypeText
rq_backingLabel
rq_backingText
rq_InstructionLabel_1
rq_InstructionLabel_2
rq_fillerMetalFrame
rq_awsSpecLabel
rq_awsSpecText
rq_awsClassificationLabel
rq_awsClassificationText
rq_fNumberLabel
rq_fNumberText
rq_positionFrame
rq_groovePipe24DownLabel
rq_groovePipe24DownText
rq_groovePlatePipe24UpLabel
rq_groovePlatePipe24UpText
rq_filletPlatePipe24UpLabel
rq_filletPlatePipe24UpText
rq_filletPipe24DownLabel
rq_filletPipe24DownText
rq_TypeOfWeldJointLabel
rq_TypeOfWeldJointText
rq_baseMetalLabel
rq_baseMetalText
rq_filletFrame
rq_filletPipeTubeThicknessLabel
rq_filletPipeTubeThicknessText
rq_filletPlateThicknessLabel
rq_filletPlateThicknessText
rq_filletPipeDiameterLabel
rq_filletPipeDiameterText
rq_grooveFrame
rq_groovePipeTubeThicknessLabel
rq_groovePipeTubeThicknessText
rq_groovePlateThicknessLabel
rq_groovePlateThicknessText
rq_groovePipeDiameterLabel
rq_groovePipeDiameterText
atv_gasFluxTypeText
atv_transferModeLabel
atv_transferModeText
atv_progressionLabel
atv_progressionText
atv_InstructionLabel_4
atv_InstructionLabel_5
atv_singleOrMultipleElectrodesLabel
atv_singleOrMultipleElectrodesText
atv_gasFluxTypeLabel
testResultsFrame
acceptanceCriteria_1Label
acceptanceCriteria_1Text
typeOfTest_1Label
typeOfTest_1Text
results_1Label
results_1Text
remarks_1Label
remarks_1Text
acceptanceCriteria_3Text
typeOfTest_3Text
results_3Text
remarks_3Text
acceptanceCriteria_2Text
typeOfTest_2Text
results_2Text
remarks_2Text
acceptanceCriteria_4Text
typeOfTest_4Text
results_4Text
remarks_4Text
acceptanceCriteria_5Text
typeOfTest_5Text
results_5Text
remarks_5Text
certificationFrame
laboratoryLabel
laboratoryText
testConductedByLabel
testNumberLabel
testNumberText
fileNumberLabel
fileNumberText
certStatementLabel_1
codeYearText
certStatementLabel_2
certStatementLabel_3
manufacturerOrContractorLabel
manufacturerOrContractorText
authorizedByLabel
authorizedByText
dateLabel
dateText
finishFrame
finishInstructionsLabel
saveProgressButton
rq_positionsQualifiedFrame
testConductedByText
AbortButton
typeOfTest_2Label
acceptanceCriteria_2Label
results_2Label
remarks_2Label
typeOfTest_3Label
typeOfTest_4Label
typeOfTest_5Label
acceptanceCriteria_3Label
acceptanceCriteria_4Label
acceptanceCriteria_5Label
results_3Label
results_4Label
results_5Label
remarks_3Label
remarks_4Label
remarks_5Label
WelderIDLabel
WelderIDText
答案 0 :(得分:0)
这将显示表单控件
的创建顺序Private Sub UserForm_Click() ' runs when form background is clicked
Stop ' put here so that the code window shows up ( press F8 or F5 to continue)
Dim i As Integer
For i = 0 To UserForm1.Controls.Count - 1
Debug.Print UserForm1.Controls(i).Name
Next i
stop
End Sub