Question

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

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

在这个简单的例子中，我有2个矩形形状，一个名称为“是”，一个名称为“否” 当用户单击“是”时，形状的颜色填充变为蓝色（“否”形状保持白色）。如果用户单击“否”，则“否”形状变为蓝色，“是”变为白色。在这个例子中，它也在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

不胜感激任何建议。三江源

Answer 1

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

我也建议使用一些With：With Activesheet.MyShape会很好。最后，请不要使用.Select。有很多理由不这样做，而且大多数选择都不会在你的代码中做任何事情......好吧，是的，慢下来。

我将举一个例子来尝试更好地解释：你可以编写一个子程序，给出一个Shape和一个布尔值（例如）作为一个输入（可能是YesNo变量）。在子例程中，您可以有条件地（If ... Else ... End If）向YesNo变量写入2个不同的行为（或者，我们是否要调用它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个形状（正方形） - ＆＃34; radio_1＆＃34;和＆＃34; radio_2＆＃34;。我还有一个用输出填充的单元格，即＆＃34;选择了Radio 1＆＃34;。在每个形状中，我将字体设置为Wingdings，并将白色字体设置为＃34; tick＆＃34;各种形状。

我还创建了单独的模块 - ＆＃34; radio＆＃34;和＆＃34;风格＆＃34; 。无线电模块包含识别被点击的形状的代码，然后从＆＃34;样式＆＃34;中调用相关的样式宏（活动/非活动）。模块。这是代码已经大大减少了我上面的原始代码并且更容易操作但是你可以想到任何其他方法来使这个更加简洁的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

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

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 Controls的设计角度来看，我发现这更加灵活。有时我会为网站构建外观和感觉相似的表格，这样我就可以制作当前网页设计中可用的类似功能和设计。

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

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

2 个答案: