Playing with Shapes and Colours

[in_d]

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

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;

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

 

[pgc01]

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:

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