在 Excel vba 脚本中使用单选按钮

Using radio buttons in an Excel vba script

提问by VikkyB

I am building a Macro to copy selected rows from a sheet to a selected sheet. For example I want to copy row 3,5,6,7 to Sheet 3. I have thought of using check boxes to select rows and radio buttons to select sheet. In my code I am setting a variable by radio buttons and that variable is used to decide the sheet in which the data has to be copied.

我正在构建一个宏以将选定的行从工作表复制到选定的工作表。例如，我想将第 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 variable is being set here by either Option button 1 or 2. And that value is being used by Sub CopyRows() But I am getting an error at Line 4 in CopyRows().*It says "Subscript Out of range".* Do you see any problem in my logic or anything else? Thanks. (Please pardon any obvious errors as I am still in learning stage of this).

Val 变量在此处由选项按钮 1 或 2 设置。Sub CopyRows() 正在使用该值，但我在 CopyRows() 的第 4 行收到错误。*它说“下标超出范围”。* 你认为我的逻辑或其他方面有什么问题吗？谢谢。（请原谅任何明显的错误，因为我仍处于学习阶段）。

回答by stenci

This is not really an answer to your question, it's a suggestion about an alternative to what you are doing. It didn't fit in a comment, so I write it here as an answer.

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

I learned to stay away from check boxes and other controls on the sheets. They are not well managed by Excel (problems working with multiple windows, with split windows, with large sheets, impossible to create hundreds of controls, etc.), and difficult to manage in VBA or VSTO.

我学会了远离表单上的复选框和其他控件。Excel 无法很好地管理它们（使用多个窗口、拆分窗口、大工作表、无法创建数百个控件等问题），并且难以在 VBA 或 VSTO 中进行管理。

I usually do something like this: when the user clicks on a cell, the Worksheet_SelectionChangechecks whether that cell containsa check box, a radio button or a button. A cell contains, or rather is, a radio button when it contains the text "?" or "¤" (with the font Wingdings), a check box when it contains the text "¨" or "t" (again Wingdings), a button when it contains whatever text you decide it's a button.

我通常这样做：当用户单击一个单元格时，Worksheet_SelectionChange检查该单元格是否包含复选框、单选按钮或按钮。当单元格包含文本“？”时，单元格包含，或者更确切地说，是一个单选按钮。或“¤”（带有 Wingdings 字体），包含文本“¨”或“t”（再次 Wingdings）时的复选框，包含您认为是按钮的任何文本时的按钮。

If the selected cell is a radio button the macro resets all the other radios to unchecked ("?") and sets the selected one to checked ("¤").

如果选定的单元格是一个单选按钮，宏会将所有其他单选按钮重置为未选中 ("?")，并将所选单元格设置为选中 ("¤")。

If the selected cell is a check box the macro swaps "¨" with "t".

如果所选单元格是复选框，则宏将“¨”与“t”交换。

If it's a button the macro executes the code associated with the button.

如果是按钮，则宏执行与按钮关联的代码。

If the selected cell is a check box or a button, the macro also selects another cell (without a fake control), to allow the user to click on the same control and fire the event again.

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

Here is an example of code. This code must be in a worksheet module, not in a code module, so the sub called Worksheet_SelectionChangeis recognized as a worksheet event and fired whenever the selection on that sheet is changed.

这是一个代码示例。此代码必须在工作表模块中，而不是在代码模块中，因此调用的 subWorksheet_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 = "t" Then
    Application.EnableEvents = False
    Target = "¨"
    Target.Offset(0, 1).Select
    Application.EnableEvents = True
  ElseIf Target.Text = "¨" Then
    Application.EnableEvents = False
    Target = "t"
    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") = "t", "Yes", "No") & vbLf
    Txt = Txt & "Check 2 = " & IIf(Range("B6") = "t", "Yes", "No") & vbLf

    MsgBox Txt

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

Here is a snippet of a worksheet that works with the code listed above:

这是与上面列出的代码一起使用的工作表的片段：