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

Streamline VBA to Change shape color on click in excel

提问by user1872463

I have a ‘form' that contains set of questions on a worksheet (note this is not a userform and I don't want to use one). Some answers are yes/no, others have multiple answers such as quantity (ie and the answer may be 1 or 2 or 3 or 4 etc).

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

The design of the ‘form' on this worksheet calls for these answers to be shapes which the user clicks like a button to select their answer - Pls note I do not want to use Command buttons.

此工作表上的“表单”设计要求这些答案是形状，用户可以像按钮一样单击这些形状来选择他们的答案 - 请注意，我不想使用命令按钮。

In this simple example I have 2 rectangle shapes one name “yes” and one name “no” When user clicks “yes”, the color fill of the shape changes to blue (and the “no” shape stays white). If user clicks “no” , the “no” shape turns blue, and “yes” goes white. It also populates and answer in A1 in this example.

在这个简单的例子中，我有 2 个矩形形状，一个名称为“yes”，一个名称为“no” 当用户单击“是”时，形状的颜色填充变为蓝色（“否”形状保持白色）。如果用户点击“no”，“no”形状变成蓝色，“yes”变成白色。在此示例中，它还在 A1 中填充和回答。

I use the following code which works fine (although im sure could be cut down somewhat) however the problem comes when I need to replicate this code multiple times. For example, if I have a question that has multiple answers like Quantity (answers could be 1 or 2 or 3 or 4 or 5) then each macro (ie for button “1” ) needs and “active” piece of coder, and a “non active” piece to designate colours to the active shape and all the other non active shapes. This is very repetitive and the code quickly becomes verbose. Im hoping there is a way to keep the formatting (fill color, text color etc) in a separate macro such as “Sub Active” and “Sub Non_Active” rather than having to repeat it time after time. I've tried to use “Call” to grab the macro containing the formatting (like Call Active) but keep getting an error.

我使用以下代码工作正常（虽然我肯定可以减少一些）但是当我需要多次复制此代码时出现问题。例如，如果我有一个问题有多个答案，例如数量（答案可能是 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

Would appreciate any suggestions. Thankyou

将不胜感激任何建议。谢谢

回答by Noldor130884

yes, you're right, you could write a Sub with your shape as an input and eventually fill it with the "yes" and "no" events. E.g. ClickOnButton MyShape, YesNowhere YesNo can be a flag that triggers one of the events. Then you could call that Sub for each button.

是的，你是对的，你可以用你的形状编写一个 Sub 作为输入，并最终用“是”和“否”事件填充它。例如ClickOnButton MyShape, YesNo，YesNo 可以是触发其中一个事件的标志。然后你可以为每个按钮调用那个 Sub 。

I also would suggest the use of some Withs: With Activesheet.MyShapeis going to do fine. Finally, please do not use the .Select. There are tons of reason not to do that and most of all the select won't do really anything in your code... Well yeah, slow it down.

我还建议使用 some Withs:With Activesheet.MyShape会很好。最后，请不要使用.Select. 有很多理由不这样做，而且大多数选择不会在你的代码中做任何事情......好吧，放慢速度。

I'll give you an example to try to explain better: You could write a subroutine giving a Shape and a Boolean (for example) as an Input (that would be the YesNovariable). Inside the subroutine you could write the 2 different behaviours conditionally (If... Else... End If) to the YesNovariable (or, do we want to call it GreenRed/ActiveInactive?). In both conditions you can write whatever you want. The following can be used for both "yes" and "no" buttons.

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

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

You can then in your Main program write Example ActiveSheet.Shapes("yes"), Trueto get a button activate itself and Example ActiveSheet.Shapes("no"), Falseto deactivate the other.

然后你可以在你的主程序中编写Example ActiveSheet.Shapes("yes"), True一个按钮来激活它自己并Example ActiveSheet.Shapes("no"), False停用另一个。

回答by user1872463

So, after taking some time away from this Ive began using the following. In this example I have 2 shapes (squares)- "radio_1" and "radio_2". I also have a cell that populates with an output ie "Radio 1 selected". In Each Shape I have the font set to Wingdings and a white colored "tick" in each shape.

因此，在离开此一段时间后，我开始使用以下内容。在这个例子中，我有 2 个形状（正方形）-“radio_1”和“radio_2”。我还有一个填充输出的单元格，即“选择了无线电 1”。在每个形状中，我将字体设置为 Wingdings，每个形状中都有一个白色的“勾号”。

I have also created separate modules - "radio" and "style" .The radio module contains the code that identifies which shape was clicked and then calls the relevant styling macro (active/inactive) from the "style" module. This is code has reduced the original code I had above greatly and is much easier to manipulate but it you can think of any other ways to make this even more succinct id love to see it (still learning!)

我还创建了单独的模块 - "radio" 和 "style" 。radio 模块包含识别单击哪个形状的代码，然后从“style”模块调用相关的样式宏（活动/非活动）。这是代码大大减少了我上面的原始代码并且更容易操作但是你可以想到任何其他方法来使这个更简洁 id 喜欢看到它（仍在学习！）

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

And the style module that changes the colors of the selected/not selected shape (active/non active) is :

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

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

This works for me and ive adapted it to replicate checkboxes , toggle switches, tabs etc. Why you may ask??? I find this far more flexible form a design perspective that AciveX Controls. Sometimes i build sheets that are similar in look and feel to websites and this way i can make similar functionality and design that is available in current web design.

这对我有用，我将它改编为复制复选框、切换开关、选项卡等。为什么你可能会问？？？我发现从设计角度来看，这比 AciveX Controls 灵活得多。有时我会构建与网站外观和感觉相似的工作表，这样我就可以制作当前网页设计中可用的类似功能和设计。

Would love to hear if this can be improved further. Cheers

很想知道这是否可以进一步改进。干杯