VBA 用户表单复选框跟踪

Question

我正在尝试创建一个 VBA 代码以根据现场数据检查特定的润滑油路线。我的代码用于生成一个动态用户表单，其中设备编号和部件名称作为复选框。

我的问题是我如何编码输入命令按钮代码以在完成列中插入“X”？

我当前的代码如下。还附上工作表的图片。

Option Explicit

Private Sub CommandButton1_Click()

Dim curColumn   As Long
Dim LastRow     As Long
Dim i           As Long
Dim chkBox      As MSForms.CheckBox
Dim ctrl        As Control

curColumn = 1 'Set your column index here
LastRow = Worksheets("Monday").Cells(Rows.Count, curColumn).End(xlUp).Row

For Each ctrl In Me.Controls
    If TypeName(ctrl) = "Checkbox" Then
        If ctrl.Value = True Then
             Worksheets("Monday").Cells(i, curColumn + 4).Value = "X"
        End If
    End If
    i = i + 1
Next ctrl
Unload Me
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
 
Dim curColumn   As Long
Dim LastRow     As Long
Dim i           As Long
Dim chkBox      As MSForms.CheckBox

curColumn = 1 'Set your column index here
LastRow = Worksheets("Monday").Cells(Rows.Count, curColumn).End(xlUp).Row

For i = 2 To LastRow
    Set chkBox = Me.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i)
    chkBox.Caption = Worksheets("Monday").Cells(i, curColumn).Value & " " & 
Worksheets("Monday").Cells(i, curColumn + 2).Value
    chkBox.Left = 5
    chkBox.Top = 5 + ((i - 1) * 20)
Next i

End Sub

Answer 1

您的问题的简单答案是您需要计算出行号i。您可以通过从复选框的名称（在初始化表单时设置）中提取它来实现这一点。在If ctrl.Value = True Then 行之后添加以下行：

i = Val(Replace(ctrl.Name, "CheckBox_", ""))

Replace(ctrl.Name, "CheckBox_", "") 从名称中删除字符串“CheckBox_”。例如，如果名称是“CheckBox_15”，您将得到字符串“15”。然后使用Val("15") 将字符串“15”计算为数值15。

进一步的建议

为了帮助您使代码更加动态，请将此函数复制到常规模块中：

Function GetColNo(sHeading As String, sSheetName As String, lHeadingsRow As Long) As Long
  Dim vHeadings As Variant
  Dim lLastCol As Long
  Dim j As Long
  
  With ThisWorkbook.Sheets(sSheetName)
    lLastCol = .Cells(lHeadingsRow, Columns.Count).End(toleft).Column
    vHeadings = .Range(.Cells(lHeadingsRow, 1), .Cells(lHeadingsRow, lLastCol))
    GetColNo = 0
    For j = 1 To lLastCol
      If LCase(vHeadings(1, j)) = LCase(sHeading) Then
        GetColNo = j
        Exit Function
      End If
    Next j
  End With
  
End Function

将用户表单模块中的所有代码替换为：

Option Explicit

Private Sub CommandButton1_Click()

    Dim curColumn   As Long
    Dim LastRow     As Long
    Dim i           As Long
    Dim chkBox      As MSForms.CheckBox
    Dim ctrl        As Control
    
    ' ****
    Dim sSheetName  As String:  sSheetName = "Monday"
    Dim lDoneCol    As Long:    lDoneCol = GetColNo("Done", sSheetName, 1)
    
    ' No need for this now
    ' curColumn = 1 'Set your column index here
    ' ****
    
    With ThisWorkbook.Sheets(sSheetName)
        LastRow = .Cells(Rows.Count, lEquipNoCol).End(xlUp).Row
        
        For Each ctrl In Me.Controls
            If TypeName(ctrl) = "Checkbox" Then
                If ctrl.Value = True Then
                     ' *****
                     ' Extract the row number i
                     i = Val(Replace(ctrl.Name, "CheckBox_", ""))
                     ' *****
                     .Cells(i, lDoneCol).Value = "X"
                End If
            End If
            ' ****
            ' No need to increment i
            'i = i + 1
        Next ctrl
    End With
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
 
    Dim curColumn   As Long
    Dim LastRow     As Long
    Dim i           As Long
    Dim chkBox      As MSForms.CheckBox
    
    ' ****
    Dim sSheetName      As String:  sSheetName = "Monday"
    Dim lEquipNoCol     As Long:    lEquipNoCol = GetColNo("Equip No", sSheetName, 1)
    Dim lPartNameCol    As Long:    lPartNameCol = GetColNo("Part Name", sSheetName, 1)
    Dim lDoneCol        As Long:    lDoneCol = GetColNo("Done", sSheetName, 1)
    
    ' No need for this now
    ' curColumn = 1 'Set your column index here
    ' ****
    
    With ThisWorkbook.Sheets(sSheetName)
        LastRow = Worksheets(sSheetName).Cells(Rows.Count, curColumn).End(xlUp).Row
        
        For i = 2 To LastRow
            Set chkBox = Me.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i)
            chkBox.Caption = .Cells(i, lEquipNoCol).Value & " " & .Cells(i, lPartNameCol).Value
            ' ****
            ' You probably should check the boxes if the corresponding value is X
            If UCase(.Cells(i, lDoneCol).Value) = "X" Then
                chkBox.Value = True
            End If
            ' ****
            chkBox.Left = 5
            chkBox.Top = 5 + ((i - 1) * 20)
        Next i
    End With
End Sub

很遗憾，我无法测试代码，因此可能存在一些拼写错误/错误，您应该可以轻松更正。

希望对你有帮助