在Excel vba脚本中使用单选按钮 [英] Using radio buttons in an Excel vba script

问题描述

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

  Public Val As String 
 Public Sub OptionButton1_Click（）
如果OptionButton1.Value = True则Val = Sheet2
 End Sub 
 
 Public Sub OptionButton2_Click（）
如果OptionButton2.Value = True则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 
 
对于cell = 2 To LRow 
如果细胞（细胞，A）。 然后
 MyLeft = Cells（单元格，E）。左
 MyTop =单元格（单元格，E）顶部
 MyHeight =单元格（单元格，E）。高度
 MyWidth =细胞（单元格，E）。宽度
 ActiveSheet.CheckBoxes.Add（MyLeft，MyTop，MyWidth，MyHeight）。选择
选择
 .Caption = 
 .Value = xlOff 
 .Display3DShading = False 
 End with 
 End If 
下一个单元格
 
 Application.ScreenUpdating = True 
 
 End Sub 
 
 
 
 Sub CopyRows（）
 
对于每个chkbx在ActiveSheet.CheckBoxes 
如果chkbx .Value = 1然后
对于r = 1 To Rows.Count 
如果单元格（r，1）.Top = chkbx.Top然后
与工作表（Val）
 LRow = .Range（A& Rows.Count）.End（xlUp）.Row + 1 
 .Range（A& LRow&：AF& LRow）= _ 
工作表（Sheet1）。范围（A& r& ：AF& r）.Value 
结束
退出
结束如果
下一步r 
结束如果
下一个
 
 End Sub 
  

Val变量在这里由选项按钮1或2设置。该值正在被Sub CopyRows（）
但是我在CopyRows（）中的第4行发现了一个错误。 * 它表示下标超出范围。 *你看到我的逻辑或其他任何问题？谢谢。 （请原谅任何明显的错误，因为我还在学习阶段）。

解决方案

这不是真正的答案问题，这是一个关于你正在做什么的替代方案的建议。它不符合评论，所以我把它写在这里作为一个答案。

我学会了远离复选框和其他控件的表格。它们不是由Excel管理（使用多个窗口的问题，分割窗口，大页面，不可能创建数百个控件等），并且难以在VBA或VSTO中进行管理。

我通常会这样做：当用户点击单元格时， Worksheet_SelectionChange 检查该单元格是否包含复选框，单选按钮或按钮。当单元格包含文本¡或¤（具有字体Wingdings）时，单元格包含或更为单选按钮，当包含文本¨或þ（再次为Wingdings）时，单元格包含或更为单选按钮，一个按钮，当它包含任何文本，你决定它是一个按钮。

如果所选单元格是单选按钮，宏将所有其他收音机重置为未选中（¡）并将所选择的单元格设置为¤。

如果选中的单元格是复选框，则用+交换¨。 >

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

如果所选单元格是复选框或一个按钮，宏还会选择另一个单元格（没有假的控制），允许用户点击相同的控件并重新启动该事件。

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

  Private Sub Worksheet_SelectionChange（ByVal Target As Range）
'如果所选范围包含多个单元格，则退出
如果Target.Columns.Count> 1然后退出Sub 
如果Target.Rows.Count> 1然后退出Sub 
 
'单选按钮
如果Target.Text =¡然后
 Application.EnableEvents = False 
范围（B1：B3 ）=¡
目标=¤
 Application.EnableEvents = True 
结束如果
 
'选中复选框
如果Target.Text =þ然后
 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 
结束如果
 
'检查按钮
 Dim Txt As String 
如果Target.Text =[显示统计数据]然后
 Txt =收音机1 =& IIf（Range（B1）=¤，是，否）& vbLf 
 Txt = Txt& Radio 2 =& IIf（Range（B2）=¤，是，否）& vbLf 
 Txt = Txt& Radio 3 =& IIf（范围（B3）=¤，是，否）& vbLf 
 Txt = Txt& 检查1 =& IIf（Range（B5）=þ，是，否）& vbLf 
 Txt = Txt& 检查2 =& IIf（Range（B6）=þ，是，否）& vbLf 
 
 MsgBox Txt 
 
 Application.EnableEvents = False 
 Target.Offset（0，1）。选择
 Application.EnableEvents = True 
 End If 
 End Sub 
  

这是一个与代码一起使用的工作表的代码片段列出如下：

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.

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).

解决方案

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.

I usually do something like this: when the user clicks on a cell, the Worksheet_SelectionChange checks whether that cell contains a 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 "þ" (again Wingdings), a button when it contains whatever text you decide it's a button.

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 "þ".

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_SelectionChange is recognized as a worksheet event and fired whenever the selection on that sheet is changed.

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

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

这篇关于在Excel vba脚本中使用单选按钮的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！