Streamline VBA可在excel中单击更改形状颜色

Question

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

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

在这个简单的示例中，我有两个矩形形状，一个名称为“yes”，另一个名称为“no”。当用户单击“yes”时，形状的颜色填充变为蓝色(而“no”形状保持白色)。如果用户单击“no”，则“no”形状变为蓝色，“yes”形状变为白色。在本例中，它还在A1中填充和回答。

我使用下面的代码，它工作得很好(虽然我确信可以减少一些)，但是当我需要多次重复这段代码时，问题就来了。例如，如果我有一个有多个答案的问题，比如数量(答案可能是1或2或3或4或5)，那么每个宏(即按钮“1”)需要一个“活动”编码器和一个“非活动”编码器，一个“非活动”块指定活动形状和所有其他非活动形状的颜色。这是非常重复的，并且代码很快变得冗长。我希望有一种方法来保持格式(填充颜色，文本颜色等)在一个单独的宏，如“子活动”和“子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。有很多理由不这样做，最重要的是，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

因此，在花了一段时间之后，Ive开始使用以下内容。在这个例子中，我有两个形状(正方形)-- "radio_1“和"radio_2”。我还有一个用输出填充的单元格，即“Radio1 selected”。在每个形状中，我将字体设置为Wingdings，并在每个形状中设置一个白色的"tick“。

我还创建了单独的模块- " radio“和"style”.The单选模块包含了识别被点击的形状的代码，然后从"style“模块调用相关的样式宏(active/inactive)。这段代码大大减少了我上面的原始代码，并且更容易操作，但是你可以想出任何其他的方法来使它更简洁，我喜欢看它(还在学习！)

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控制的设计角度来看，我发现这要灵活得多。有时，我构建的工作表在外观和感觉上与网站相似，这样我就可以做出与当前网页设计类似的功能和设计。

我很乐意听到这一点是否可以进一步改进。干杯