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

时间:2013-07-12 16:25:46

标签: excel vba

我正在构建一个宏来将选定的行从工作表复制到选定的工作表。例如,我想将第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行遇到错误。 * 它说“下标超出范围”。 *你看到我的逻辑或其他任何问题?谢谢。 (请原谅任何明显的错误,因为我还处于学习阶段)。

1 个答案:

答案 0 :(得分:8)

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

我学会了远离床单上的复选框和其他控件。它们没有得到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

以下是使用上述代码的工作表片段:

enter image description here