在 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

选项按钮 1 或 2 在此处设置 Val 变量。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

这是一个工作表的 sn-p，可与上面列出的代码一起使用：