创建通用复选框\u单击VBA代码

我正在创建一个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列中，我想知道是否有一种更快的方法和更干净的方法来做这件事，而不是有一个很长的列表。

尝试类似的方法。您必须设置每个复选框的格式，并从format | assign macro选项将此宏分配给每个复选框

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

---

我假设您要将用户名值分配给复选框的下一个单元格。 对于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

端接头

请在激活的工作表中更新以下代码

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

---

为了清楚起见，您可以选择所有复选框，然后在一个操作中将宏分配给所有复选框。

Application.Caller

对于多个重复操作非常有用。已经救了我很多次。@DavidZemens这不是一个问题，这是一个观察。我的错误-对不起，我以为你在问后续问题。这很有效，只是它把名字放在E2而不是E3中。我通过将偏移量更改为（1,1）来解决这个问题，以防有人对D3的正确性感到好奇。对于D3，它将更新E3等。我正在运行这一个，但得到一个400错误。我所做的唯一更改是在相应的位置将sheet1更改为sheet5。