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

Question

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

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

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

我使用下面的代码，它工作得很好（尽管我确信可以稍微减少一些），但是当我需要多次复制此代码时，问题就出现了。例如，如果我有一个有多个答案的问题，例如数量（答案可以是 1 或 2 或 3 或 4 或 5），则每个宏（即按钮“1”）需要和“活动”编码器，以及“非活动”部分用于为活动形状和所有其他非活动形状指定颜色。这是非常重复的，并且代码很快就会变得冗长。我希望有一种方法可以将格式（填充颜色、文本颜色等）保留在单独的宏中，例如“Sub Active”和“Sub Non_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

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

Answer 1

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

ClickOnButton MyShape, YesNo

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

我还建议使用一些

With

：

With Activesheet.MyShape

会很好。最后，请不要使用

.Select

。有很多理由不这样做，而且最重要的是 select 在你的代码中不会做任何事情......好吧，放慢速度。

我会给你一个例子来更好地解释：你可以编写一个子例程，给出一个形状和一个布尔值（例如）作为输入（这将是

YesNo

变量）。在子例程中，您可以有条件地将两种不同的行为 (

If

...

Else

...

End If

) 写入

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

然后，您可以在主程序中编写

Example ActiveSheet.Shapes("yes"), True

来激活按钮本身，并编写

Example ActiveSheet.Shapes("no"), False

来停用另一个按钮。

Answer 2

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

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

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

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

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

Answer 3

这太棒了，您能否分享其他两个模块（无线电和样式）的详细信息，以便我看看您的完整解决方案是否适合我。.看起来很优雅，因为我也想摆脱 Active X 按钮..谢谢

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

问题描述投票：0回答：3

3个回答

最新问题

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

问题描述 投票：0回答：3

3个回答

最新问题

问题描述投票：0回答：3