Modify fill colour when shape is clicked Hello community, I have a small problem

Question

Modify fill colour when shape is clicked

Hello community,

I have a small problem. I have a rectangular shape with three circles in it, the upper most is red, the middle is amber and the bottom is green (a traffic light). I want to use a VBA macro to create this functionality:

When the upper most circle is clicked the other circles are filled with white.

When the middle circle is clicked the other circles are filled with white.

When the bottom circle is clicked the other circles are filled with white.

However, I cannot make this work. Could someone help me in the right direction on how to do this?

Best Regards

Explanation / Answer

When I looked at this I wasn't certain that it would be possible, but after playing around for a few minutes it appears to be.

You can record the steps, which will give you the names of the shapes and the styles to attach and you will probably end up with something akin to the following (The rectangle code puts the three original colours back when you click the rectangle). Because these are shapes you would not want to leave them selected, so after running the macro the cursor is moved to A1

It's somewhat Heath Robinson but it appears to do the job - in Excel 2010 at least. (The shapes you have are likely to have different names).

Sub Oval2_Click()
    ActiveSheet.Shapes.Range(Array("Oval 4")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
    ActiveSheet.Shapes.Range(Array("Oval 5")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset4
    ActiveSheet.Shapes.Range(Array("Oval 2")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset38
    Cells(1, 1).Select
End Sub
Sub Oval4_Click()
    ActiveSheet.Shapes.Range(Array("Oval 5")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset4
    ActiveSheet.Shapes.Range(Array("Oval 2")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset3
    ActiveSheet.Shapes.Range(Array("Oval 4")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset42
    Cells(1, 1).Select
End Sub
Sub Oval5_Click()
    ActiveSheet.Shapes.Range(Array("Oval 4")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
    ActiveSheet.Shapes.Range(Array("Oval 2")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset3
    ActiveSheet.Shapes.Range(Array("Oval 5")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    Cells(1, 1).Select
End Sub

Sub Rectangle1_Click()
    ActiveSheet.Shapes.Range(Array("Oval 2")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset38
    ActiveSheet.Shapes.Range(Array("Oval 4")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset42
    ActiveSheet.Shapes.Range(Array("Oval 5")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    Cells(1, 1).Select
End Sub

Related Questions

Navigate

• Browse (All)
• Browse M
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.