如何用尽可能少的代码更改多个选项按钮的颜色

时间:2015-06-30 09:50:54

标签: vba

我有一个包含70行x 6列的电子表格,其中包含420个选项按钮,分组为6,即group1 = optionbutton1,71.141,211,281和351.Group2 = Optionbutton2,72,142,282和352.

这是我根据按钮值更改背景颜色的代码:

Private Sub OptionButton1_Change()

With OptionButton1

    If .Value Then
        .BackColor = vbRed ' or RGB(255, 0, 0)
    Else
        .BackColor = vbGreen ' or RGB(0,0,0)
    End If

End With

End Sub

我需要为所有420个选项按钮执行此操作,但这可能需要一段时间才能复制并且更有可能丢失条目。 是否有一种方法可以缩短此代码或更改代码以应用于工作表上的任何选项按钮,以便在为false时更改为红色或为绿色时更改为绿色?

1 个答案:

答案 0 :(得分:0)

看起来您正在使用ActiveX选项按钮,不幸的是,我不相信有办法解决必须与每个选项按钮的更改或点击事件相关联的代码您希望它在用户更改选项时自动更改Controls BackColor。

另一种方法是使用表单控件选项按钮,因为您可以将它们全部设置为在更改选择时运行相同的代码。采用这种方法,您可以使用单个方法循环遍历工作表上的每个选项按钮,并根据其值更改其背景颜色。

以下是如何执行此操作的示例。在Visual Basic编辑器中,将新模块添加到项目中。只要更改了选项按钮,就会调用此函数,它将通过工作表上的每个选项按钮并更改其颜色。

Sub optionButtonChange()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim formShape As shape

    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet

    For Each formShape In ws.Shapes
        If formShape.Type = MsoShapeType.msoFormControl Then
            If TypeName(formShape.OLEFormat.Object) = "OptionButton" Then
                If formShape.OLEFormat.Object.Value = 1 Then
                    formShape.OLEFormat.Object.Interior.Color = vbRed
                Else
                formShape.OLEFormat.Object.Interior.Color = vbGreen
                End If
            End If
        End If
    Next

    Set ws = Nothing
    Set wb = Nothing


End Sub

现在要使其工作,您需要将其分配给选项按钮'宏' - 您可以通过右键单击选项按钮并选择它来手动执行此操作,也可以通过将其应用于工作表上的每个选项按钮以编程方式执行此操作,如下例所示:

Sub changeOnAction()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim formShape As shape

    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet

    For Each formShape In ws.Shapes
        If formShape.Type = MsoShapeType.msoFormControl Then
            If TypeName(formShape.OLEFormat.Object) = "OptionButton" Then
                ' Macro name format is "'<workbooks filename>'!functionToCall"
                formShape.OnAction = "'" & wb.Name & "'!optionButtonChange"
            End If
        End If
    Next

    Set formShape = Nothing
    Set ws = Nothing
    Set wb = Nothing

End Sub

要使用此功能,请确保打开带有选项按钮的工作表,并从Visual Basic编辑器中运行代码。完成后,单击工作表上的任何选项按钮将触发初始代码示例,并且它们都应自动重新着色。