Question

我的用户表单中有复选框，根据选中的复选框中的ID，我想激活工作簿中特定用户的工作表。我遇到了以下代码的某些部分，但它无法正常工作。

Option Explicit
Private Sub Add_Click()
 Dim ctrl As Control
 For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
TransferValues ctrl
End If
Next
End Sub

Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim emptyRow As Long

If cb.Value = True Then
   'Define the worksheet based on the CheckBox.Name property:
    Set ws = Sheets(Left(cb.Name, 1))
    emptyRow = WorksheetFunction.CountA(ws.Range("F:F")) + 1
       With ws
            If Trim(Me.ComboBox3.Value) = "" Or Trim(Me.ComboBox6.Value) = "" Then
            MsgBox ("Please enter text in all fields")
            Exit Sub
            End If
                If WorksheetFunction.CountIf(ws.Range("F:F"), ComboBox3.Value) = 0 Or WorksheetFunction.CountIf(ws.Range("G:G"), ComboBox6.Value) = 0 Then
                    Cells(emptyRow, 6).Value = ComboBox3.Value
                    Cells(emptyRow, 7).Value = ComboBox6.Value
                    Cells(emptyRow, 8).Value = TextBox1.Value
            Else
                MsgBox ("Warning:Duplicate Entries found. Please update the existing entries")
        End If
       End With
End If

End Sub

Answer 1

自己找到解决方案。如果有人面对，请使用以下代码解决此类问题。

Private Sub CommandButton1_Click()
Dim ctrl As Control
For Each ctrl In Userform1.Controls
  If TypeName(ctrl) = "CheckBox" Then
  TransferValues ctrl
  End If
  Next
End Sub

Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim emptyRow As Long
'Dim ID As String

If cb.Value = True Then
    Set ws = Sheets(Left(cb.Caption, 6))
        If Trim(Me.ComboBox3.Value) = "" Or Trim(Me.ComboBox6.Value) = "" Then
        MsgBox ("Please Enter the text in All Fields")
        End If
    emptyRow = WorksheetFunction.CountA(ws.Range("F:F")) + 1
      With ws
        If WorksheetFunction.CountIf(ws.Range("F:F"), ComboBox3.Value) = 0 Or WorksheetFunction.CountIf(ws.Range("G:G"), ComboBox6.Value) = 0 Then

        .Cells(emptyRow, 6).Value = ComboBox3.Value
        .Cells(emptyRow, 7).Value = ComboBox6.Value
        .Cells(emptyRow, 8).Value = TextBox1.Value
        Else
        MsgBox ("Warning:Duplicate Entries Found. Please edit existing entries")
        End If

      End With
End If

End Sub

根据userform中复选框的选择激活工作表

1 个答案: