创建通用 Checkbox_Click VBA 代码

Question

我正在创建一个作为清单的 excel 文件，目前我在 D 列中有 73 个复选框，在 E 列中，它将根据选项字段中的用户名填充用户名。

目前我有如下代码：

Sub CheckBox1_Click()
 If ActiveSheet.CheckBoxes("Check Box 1").Value = 1 Then
   Range("E3").Value = Application.UserName
   Else: Range("E3").Value = ""
 End If
End Sub
Sub CheckBox2_Click() 
If ActiveSheet.CheckBoxes("Check Box 2").Value = 1 Then
   Range("E4").Value = Application.UserName
   Else: Range("E4").Value = ""
 End If
End Sub

对于 D 列中的每个复选框。它确实有效，但我现在需要在一周的其他日子将 D 列复制到 F、H、J、L 列中，我很好奇是否有更快的方法来做到这一点，并且一种更简洁的方法来执行此操作，而不是列出一长串。

Answer 1

试试这样的。您必须格式化每个复选框并将此宏分配给每个复选框，从格式 |分配宏选项。

Sub Generic_ChkBox()
Dim cbName As String
Dim cbCell As Range
Dim printValue as String

cbName = Application.Caller

Set cbCell = ActiveSheet.CheckBoxes(cbName).TopLeftCell

Select Case cbCell.Column
    Case 4
        'prints the username in column E
        printValue = Application.UserName
    Case 6
        'prints "Something else" in column G
        printValue = "Something else"
    Case 8
        'prints "etc..." in column I, etc.
        printValue = "etc..."
    Case 10
        printValue = "etc..."
    Case 12
        printValue = "etc..."
End Select

If ActiveSheet.CheckBoxes(cbName).Value = 1 Then
    cbCell.Offset(0, 1).Value = printValue
Else
    cbCell.Offset(0, 1).Value = vbNullString
End If

End Sub

Answer 2

我假设您要将用户名值分配给 CheckBox 的下一个单元格。 对于 D4 有复选框，那么值将是 E4。

Sub ProcessAllCheckBox()
 Dim ws As Worksheet, s As Shape
 Sheets("Sheet1").Columns("A:Z").ClearContents
  Set ws = ActiveSheet
  For Each chk In ActiveSheet.CheckBoxes
   If chk.Value = 1 Then
     Set s = ws.Shapes(chk.Caption)
     Sheets("Sheet1").Range(Cells(s.TopLeftCell.Row, s.TopLeftCell.Column + 1),  Cells(s.TopLeftCell.Row, s.TopLeftCell.Column + 1)).Value = Application.UserName
  End If
 Next

结束子

请在 WorkShee Active 中更新以下代码

Private Sub Worksheet_Activate()
For Each chk In ActiveSheet.CheckBoxes
  chk.OnAction = "ProcessAllCheckBox"
Next
ProcessAllCheckBox
End Sub