Playing with Shapes and Colours

in_d

New Member
Joined
Mar 3, 2009
Messages
47
Hello,
I have a worksheet called Sheet2 with 75 freeform items. Each shape is called Shape1, Shape2, Shape3 ... Shape75.
I would like to change the color of the shape everytime the shape is clicked. I have no preference to the colours, but to give you an idea of what I mean, each time the shape is clicked, the color will change as follows;
Black
Blue
Brown
Red
Orange
Yellow
White
And then start back at Black if all the colors have been chosen. At present, I have attached a bit of code to each shape which calls the following function
Code:
Sub ColorChanger()
Sheets("sheet3").Range("A" & i).Value = Sheets("sheet3").Range("A" & i).Value + 1
CellRef = Sheets("sheet3").Range("A" & i).Value
Select Case CellRef
Case 1
Sheets("sheet2").Shapes("Shape" & i).Fill.Transparency = 0.5
Sheets("sheet2").Shapes("shape" & i).Fill.ForeColor.RGB = RGB(255, 0, 0)
Case 2
Sheets("sheet2").Shapes("Shape" & i).Fill.Transparency = 0.5
Sheets("sheet2").Shapes("shape" & i).Fill.ForeColor.RGB = RGB(0, 255, 0)
Case 3
Sheets("sheet2").Shapes("Shape" & i).Fill.Transparency = 0.5
Sheets("sheet2").Shapes("shape" & i).Fill.ForeColor.RGB = RGB(0, 0, 255)
Case 4
Sheets("sheet2").Shapes("Shape" & i).Fill.Transparency = 0.5
Sheets("sheet2").Shapes("shape" & i).Fill.ForeColor.RGB = RGB(255, 255, 0)
Case 5
Sheets("sheet2").Shapes("Shape" & i).Fill.Transparency = 0.5
Sheets("sheet2").Shapes("shape" & i).Fill.ForeColor.RGB = RGB(0, 100, 100)
Case 6
Sheets("sheet2").Shapes("Shape" & i).Fill.Transparency = 0.5
Sheets("sheet2").Shapes("shape" & i).Fill.ForeColor.RGB = RGB(255, 0, 255)
Case 7
Sheets("sheet3").Range("A" & i).Value = 0
Sheets("sheet2").Shapes("Shape" & i).Fill.Transparency = 1#
Sheets("sheet2").Shapes("shape" & i).Fill.ForeColor.RGB = RGB(255, 255, 255)
End Select
End Sub
The code attached to the shape is;
Code:
Sub Shape1_Click()
i = 1
    Call ColorChanger
End Sub
 
 
Sub Shape2_Click()
i = 2
    Call ColorChanger
End Sub

Although I have done all the coding and the document seems to work as I would have liked, there must be a better way to do it?
Thanks
Indi
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,877
Hi Indi

The only thing your 75 Click macros do is assign the value to the shape index and then call ColorChanger().

You can instead of using a different macro for each shape, assign to your 75 shapes the ColorChanger() sub directly and detect which shape was clicked.

Ex:

Code:
Sub ColorChanger()
Dim sName As String
Dim lInd As Long, lColor As Long
Dim arrColors
 
sName = Application.Caller                ' name of the shape that was clicked
lInd = CLng(Replace(sName, "Shape", ""))    ' assuming the shapes have names like "Shape34"
 
arrColors = Array(RGB(255, 255, 255), RGB(255, 0, 0), RGB(0, 255, 0), RGB(0, 0, 255), _
                         RGB(255, 255, 0), RGB(0, 100, 100), RGB(255, 0, 255))
 
With Sheets("Sheet3").Range("A" & lInd)
    .Value = (.Value + 1) Mod 7
    lColor = .Value
End With
 
With Worksheets("Sheet2").Shapes(sName).Fill
    .Transparency = IIf(lColor = 0, 1, 0.5)
    .ForeColor.RGB = arrColors(lColor)
End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,224
Messages
5,594,914
Members
413,952
Latest member
JGer

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top