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

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

在这个工作表上的“表单”的devise要求这些答案是用户点击的形状，像一个button来select他们的答案 – 请注意我不想使用命令button。

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

我使用下面的代码工作正常（虽然我确定可以减less），但是当我需要多次复制这个代码时，问题来了。 例如，如果我有一个问题有多个答案，如数量（答案可能是1或2或3或4或5），那么每个macros（即button“1”）需要和“活动”的编码器， “非主动”部分用于将颜色指定为活动形状以及所有其他非活动形状。 这是非常重复的，代码很快变得冗长。 我希望有一种方法来保持格式（填充颜色，文字颜色等）在一个单独的macros，如“副主动”和“副非主动”，而不是不得不重复一次。 我试图使用“调用”来获取包含格式的macros（如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 

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

Answer 1

是的，你是对的，你可以用你的形状写一个Sub作为input，最后填入“是”和“否”事件。 例如ClickOnButton MyShape, YesNo其中YesNo可以是触发其中一个事件的标志。 然后你可以调用每个button的Sub。

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

我给你一个例子来更好地解释：你可以写一个给出一个Shape和一个布尔值（例如）作为input（这将是YesNovariables）的YesNo 。 在子程序里，你可以有条件地写入2个不同的行为（ If … Else … End If ）给YesNovariables（或者，我们是否要把它GreenRed / ActiveInactive ？）。 在这两种情况下，你可以写任何你想要的。 以下可用于“是”和“否”button。

 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 

然后你可以在你的Main程序中写下Example ActiveSheet.Shapes("yes"), True来获得一个button自己激活， Example ActiveSheet.Shapes("no"), False去激活另一个。

Answer 2

所以，在离开这段时间之后，我开始使用以下内容。 在这个例子中，我有2个形状（正方形） – “radio_1”和“radio_2”。 我也有一个单元，填充输出，即“无线电1select”。 在每个形状我有字体设置为Wingdings和白色的每个形状的“勾”。

我还创build了单独的模块 – “无线电”和“风格”。无线电模块包含标识哪个形状被点击的代码，然后从“样式”模块调用相关样式macros（活动/不活动）。 这是代码减less了我以上大大的原始代码，更容易操作，但它可以想出任何其他方式，使这个更简洁的编号爱看到它（仍然学习！）

 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 

而改变所选/未select形状（有效/无效）的颜色的样式模块是：

 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 

这适用于我和IIVE调整它复制checkbox，切换开关，选项卡等为什么你可能会问？ 从AciveX控件的deviseangular度来看，我觉得这更加灵活。 有时候，我会在网站的外观和感觉上构build相似的表单，这样我就可以制作出类似的function和devise，可以在当前的网页devise中使用。

如果这可以进一步改善，我们很乐意听到。 干杯