简化VBA以在excel中单击时更改形状颜色

我有一个“表单”，其中包含工作表上的一组问题（请注意，这不是一个用户表单，我不想使用它）。 有些答案为是/否，其他答案有多个，如数量（即答案可能是1或2或3或4等）

此工作表上的“表格”设计要求这些答案为用户点击按钮选择答案的形状-请注意，我不想使用命令按钮

在这个简单的例子中，我有两个矩形，一个是“是”，一个是“否” 当用户单击“是”时，形状的颜色填充变为蓝色（“否”形状保持白色）。如果用户单击“否”，则“否”形状变为蓝色，“是”变为白色。在本例中，它还填充并回答A1

我使用了下面的代码，它工作得很好（虽然我确信可以减少一些），但是当我需要多次复制这段代码时，问题就出现了。例如，如果我有一个问题有多个答案，比如数量（答案可以是1或2或3或4或5），那么每个宏（即按钮“1”）都需要一个“活动”的编码器，一个“非活动”的编码器指定活动形状和所有其他非活动形状的颜色。这是非常重复的，代码很快就会变得冗长。 我希望有一种方法可以将格式（填充颜色、文本颜色等）保存在单独的宏中，例如“Sub-Active”和“Sub-Non-Active”，而不是一次又一次地重复。我曾尝试使用“Call”来获取包含格式的宏（如Call Active），但一直出现错误

Sub yes_button()

'active
ActiveSheet.Shapes("yes").Select
ActiveSheet.Shapes("yes").Fill.ForeColor.RGB = RGB(85, 142, 213)                          ' fill: dark blue color
ActiveSheet.Shapes("yes").Line.BackColor.RGB = RGB(198, 217, 241)                        ' border: light blue color
ActiveSheet.Shapes("yes").TextFrame.Characters.Font.Color = RGB(255, 255, 255)       '         text: white color
Range("A1").Formula = "YES" ' fills cell with button value

' nonactive
ActiveSheet.Shapes("no").Select
ActiveSheet.Shapes("no").Fill.ForeColor.RGB = RGB(255, 255, 255)                  '     fill: light blue color
ActiveSheet.Shapes("no").Line.BackColor.RGB = RGB(198, 217, 241)                  ' border: light blue color
ActiveSheet.Shapes("no").TextFrame.Characters.Font.Color = RGB(85, 142, 213)     ' text: dark blue color



End Sub

Sub no_button()

'active
ActiveSheet.Shapes("no").Select
ActiveSheet.Shapes("no").Fill.ForeColor.RGB = RGB(85, 142, 213)                       '     fill: dark blue color
ActiveSheet.Shapes("no").Line.BackColor.RGB = RGB(198, 217, 241)                      '    border: light blue color
ActiveSheet.Shapes("no").TextFrame.Characters.Font.Color = RGB(255, 255, 255)       ' text: white color
Range("A1").Formula = "NO" ' fill scell with button value
' nonactive

ActiveSheet.Shapes("yes").Select
ActiveSheet.Shapes("yes").Fill.ForeColor.RGB = RGB(255, 255, 255)                  ' fill: light blue color
ActiveSheet.Shapes("yes").Line.BackColor.RGB = RGB(198, 217, 241)                  '     border: light blue color
ActiveSheet.Shapes("yes").TextFrame.Characters.Font.Color = RGB(85, 142, 213)     '     text: dark blue color

End Sub

如有任何建议，我们将不胜感激。

---

谢谢

是的，您是对的，您可以用您的形状作为输入来编写一个Sub，并最终用“是”和“否”事件填充它。例如，

单击按钮MyShape，YesNo

，其中YesNo可以是触发其中一个事件的标志。 然后，你可以为每个按钮调用该Sub

我还建议将一些

与

s:

与Activesheet一起使用。最后，请不要使用
。选择
。有很多理由不这么做，最重要的是，select在代码中不会做任何事情。。。嗯，是的，放慢速度

我将给你一个例子来更好地解释：你可以编写一个子程序，给出一个形状和一个布尔值（例如）作为输入（这将是
YesNo
变量）。在子例程中，您可以有条件地将两种不同的行为（
If
..
Else
..
End If
）写入
YesNo
变量（或者，我们是否要将其称为
GreenRed
/
ActiveInactive
？）。在这两种情况下，你可以写任何你想写的东西。
以下内容可用于“是”和“否”按钮

然后你可以在主程序中编写
Example-ActiveSheet.Shapes（“yes”）、True
来激活一个按钮，然后编写
Example-ActiveSheet.Shapes（“no”）、False
来停用另一个按钮。
在这个例子中，我有两个形状（正方形）-“radio_1”和“radio_2”。我还有一个单元格，其中填充了一个输出，即“Radio 1 selected”。在每个形状中，我都将字体设置为Wingdings，每个形状中都有一个白色的“勾号”

我还创建了单独的模块-“radio”和“style”。radio模块包含识别单击哪个形状的代码，然后从“style”模块调用相关的样式宏（active/inactive）。
这段代码大大减少了我上面的原始代码，并且更易于操作，但是您可以想出任何其他方法使其更加简洁，我很乐意看到它（仍在学习！）

更改选定/未选定形状（活动/非活动）颜色的样式模块为：

这对我来说很有用，我把它改造成复制复选框、切换开关、标签等。你为什么会问？？？我发现从AciveX控制的设计角度来看，这种方式更加灵活。有时，我构建的表单在外观和感觉上与网站相似，这样我就可以实现当前web设计中可用的类似功能和设计

我很想知道这是否可以进一步改进。干杯
谢谢你的回复，诺尔多。抱歉，我忘了提到形状中的文本没有改变（当然，文本的颜色会改变，但是单词“是”已经显示在“是”形状中，“否”形状中显示“否”，因此用户知道要单击哪个形状）。我不知道如何合并Clickonbutton Myshape y/n，其中有多个选项可供选择（例如编号为1到5的5个形状）。这可能吗？抱歉，这里已经很晚了，我的代码在晚上10点后迅速恶化：（编辑了我以前的答案，以便更好地解释我的意思：）谢谢诺尔多。我试试看，告诉你我的进展。很高兴能帮上忙！如果你偶然发现了新的错误，更新你的问题，我来看看
Sub Example(YourShape As Shape, GreenRed as Boolean)

    If GreenRed = True Then ' Say we want in this case an "active" button
        With YourShape
            .Fill.ForeColor.RGB = RGB(85, 142, 213)
            .Line.BackColor.RGB = RGB(198, 217, 241)
            .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
        End With
    Else
        With YourShape
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
            .Line.BackColor.RGB = RGB(198, 217, 241)
            .TextFrame.Characters.Font.Color = RGB(85, 142, 213) 
        End With
    End If

End Sub

Sub radio_btn_grp_1()

Dim wb As Workbook
Dim ws As Worksheet
Dim oShape1 As Shape

Set wb = ActiveWorkbook
Set ws = wb.Sheets("radio_btns")
Set oShape1 = ws.Shapes(CallingShapeName)

CallingShapeName = ws.Shapes(Application.Caller).Name

If CallingShapeName = "radio_1" Then
Call Active

ws.Range("radio_btn_val_1").Value = "Radio 1 Selected"

Dim arShapes1() As Variant
Dim objRange1 As Object
arShapes1 = Array("radio_2")
Set objRange1 = ws.Shapes.Range(arShapes1)

With objRange1
    .Line.ForeColor.RGB = RGB(0, 153, 153)
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)

End With

Else

If CallingShapeName = "radio_2" Then

    Call Active

    ws.Range("radio_btn_val_1").Value = "Radio 2 selected"

    Dim arShapes2() As Variant
    Dim objRange2 As Object
    arShapes2 = Array("radio_1")
    Set objRange2 = ws.Shapes.Range(arShapes2)

    With objRange2
        .Line.ForeColor.RGB = RGB(0, 153, 153)
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)

    End With
End If
End If

End Sub

Sub Active() ' Change colors of active checkbox to green (and add "tick")

Dim wb As Workbook
Dim ws As Worksheet
Dim oShape1 As Shape

Set wb = ActiveWorkbook
Set ws = wb.Sheets("radio_btns")
Set oShape1 = ws.Shapes(CallingShapeName)

CallingShapeName = ws.Shapes(Application.Caller).Name




    With oShape1
    .Line.ForeColor.RGB = RGB(0, 153, 153)
    .Fill.ForeColor.RGB = RGB(0, 153, 153)
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Characters.Text = "ü"                             ' add tick - ensure font is windings
End With
End Sub

Sub Inactive()  ' Change colors of active checkbox to white (and remove "tick")

Dim wb As Workbook
Dim ws As Worksheet
Dim oShape1 As Shape

Set wb = ActiveWorkbook
Set ws = wb.Sheets("radio_btns")
Set oShape1 = ws.Shapes(CallingShapeName)

CallingShapeName = ws.Shapes(Application.Caller).Name
With oShape1
    .Line.ForeColor.RGB = RGB(175, 171, 171)
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Characters.Text = ""                                  ' clear tick
End With
End Sub