excel - 在 Excel VBA 脚本中使用单选按钮

Question

我正在构建一个宏，以将选定的行从工作表复制到选定的工作表。例如，我想将第 3,5,6,7 行复制到工作表 3。我想过使用复选框来选择行，使用单选按钮来选择工作表。在我的代码中，我通过单选按钮设置一个变量，该变量用于决定必须在其中复制数据的工作表。

Public Val As String
Public Sub OptionButton1_Click()
If OptionButton1.Value = True Then Val = "Sheet2"
End Sub

Public Sub OptionButton2_Click()
If OptionButton2.Value = True Then Val = "Sheet3"
End Sub


Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "E").Left
        MyTop = Cells(cell, "E").Top
        MyHeight = Cells(cell, "E").Height
        MyWidth = Cells(cell, "E").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell

Application.ScreenUpdating = True

End Sub



Sub CopyRows()

For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets(Val)
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & ":AF" & LRow) = _
                    Worksheets("Sheet1").Range("A" & r & ":AF" & r).Value
                End With
                Exit For
            End If
        Next r
    End If
Next

End Sub

Val 变量在此处通过选项按钮 1 或 2 设置。该值由 Sub CopyRows() 使用但我在 CopyRows() 的第 4 行遇到错误。 *它显示“下标超出范围”。* 您是否发现我的逻辑或其他任何问题？谢谢。 (请原谅任何明显的错误，因为我仍处于学习阶段)。

Answer 1

这并不是对您问题的真正答案，而是对您正在做的事情的替代方案的建议。它不适合评论，所以我把它写在这里作为答案。

我学会了远离工作表上的复选框和其他控件。它们不能被 Excel 很好地管理(使用多个窗口、分割窗口、大工作表时出现问题，无法创建数百个控件等)，并且难以在 VBA 或 VSTO 中管理。

我通常会这样做:当用户单击某个单元格时，Worksheet_SelectionChange 检查该单元格是否包含复选框、单选按钮或按钮。当单元格包含文本“¡”或“¤”(字体为 Wingdings)时，单元格包含(或者更确切地说是)单选按钮；当单元格包含文本“¡”或“þ”(又是 Wingdings)时，单元格包含复选框，当它包含您确定它是按钮的任何文本时，它就是一个按钮。

如果所选单元格是单选按钮，则宏会将所有其他单选按钮重置为未选中状态(“¡”)，并将所选单元格设置为选中状态(“¤”)。

如果所选单元格是复选框，则宏会将“¡”交换为“þ”。

如果它是一个按钮，宏将执行与该按钮关联的代码。

如果选定的单元格是复选框或按钮，则宏还会选择另一个单元格(没有假控件)，以允许用户单击同一控件并再次触发事件。

这是一个代码示例。此代码必须位于工作表模块中，而不是代码模块中，因此名为 Worksheet_SelectionChange 的子组件被识别为工作表事件，并在该工作表上的选择发生更改时触发。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'exit if the selected range contains more than one cell
  If Target.Columns.Count > 1 Then Exit Sub
  If Target.Rows.Count > 1 Then Exit Sub

  'check for radio buttons
  If Target.Text = "¡" Then
    Application.EnableEvents = False
    Range("B1:B3") = "¡"
    Target = "¤"
    Application.EnableEvents = True
  End If

  'check for check boxes
  If Target.Text = "þ" Then
    Application.EnableEvents = False
    Target = "¨"
    Target.Offset(0, 1).Select
    Application.EnableEvents = True
  ElseIf Target.Text = "¨" Then
    Application.EnableEvents = False
    Target = "þ"
    Target.Offset(0, 1).Select
    Application.EnableEvents = True
  End If

  'check for button
  Dim Txt As String
  If Target.Text = "[Show stats]" Then
    Txt = "Radio 1 = " & IIf(Range("B1") = "¤", "Yes", "No") & vbLf
    Txt = Txt & "Radio 2 = " & IIf(Range("B2") = "¤", "Yes", "No") & vbLf
    Txt = Txt & "Radio 3 = " & IIf(Range("B3") = "¤", "Yes", "No") & vbLf
    Txt = Txt & "Check 1 = " & IIf(Range("B5") = "þ", "Yes", "No") & vbLf
    Txt = Txt & "Check 2 = " & IIf(Range("B6") = "þ", "Yes", "No") & vbLf

    MsgBox Txt

    Application.EnableEvents = False
    Target.Offset(0, 1).Select
    Application.EnableEvents = True
  End If
End Sub

以下是与上面列出的代码配合使用的工作表片段: