Try the following in a test sheet
Sub makeOvals()
Dim r As Long, c As Long
Dim ovl As Oval
Dim shp As Shape
Dim nClr As Long
Dim sName As String
ActiveSheet.Ovals.Delete
For r = 1 To 30
For c = 1 To 3
With ActiveSheet.Cells(r + 1, c + 1)
Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, .Left +
0.75, .Top + 0.75, .Height - 1.5, .Height - 1.5)
End With
Select Case c
Case 1
sName = "Red_"
nClr = RGB(255, 0, 0)
Case 2
sName = "Amber_"
nClr = RGB(255, 204, 0)
Case 3
sName = "Green_"
nClr = RGB(0, 235, 0)
End Select
shp.Name = sName & Right$("0" & r, 2) & "_" & c
shp.Fill.ForeColor.RGB = nClr
shp.Line.Visible = msoFalse
shp.Fill.Visible = msoTrue
shp.OnAction = "TrafficLights"
Next
Next
Application.ScreenUpdating = True
End Sub
Sub TrafficLights()
Dim nRow As Long, nCol As Long
Dim sCaller As String
Dim arrCaller
sCaller = Application.Caller
arrCaller = Split(sCaller, "_")
With ActiveSheet.Shapes(sCaller).TopLeftCell
nRow = .Row
nCol = .Column
End With
Select Case arrCaller(0)
Case "Red"
'do stuff with arrCaller(1) & arrCaller(2)
' and/or nRow & nCol
Case "Amber"
' code
Case "Green"
' code
End Select
MsgBox arrCaller(0) & vbCr & Val(arrCaller(1)) & vbCr &
Val(arrCaller(2)) _
& vbCr & nRow & vbCr & nCol, , sCaller
End Sub
The above assigns all to just the one macro, but you could easily adapt to
use three.
Dim sOnAction as string
Select Case c
case 1: sOnAction = "myRedMacro"
etc
shp.OnAction = sOnAction
Regards,
Peter T
<(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Hi,
>
> I am in dire need of help.
> Currently I have created 3 basic shapes, oval, to represent red,
> yellow and green respectively. I have also assigned a macro to each
> shapes so that when I clicked on it, the colour will change
> accordingly. My 3 shapes are in one cell. My problem is that I have at
> least 30 rows and each row has 3 columns of these shapes.. Total is 90
> oval shapes... numbering from 1 to 90... In order to create successful
> macro, I have to create 90 macros (because of the oval shapes
> numbering). Is there any shortcut whereby I can create only 3 macros
> and assign it accordingly w/o having it linked to other shapes.
>
> Appreciate all help given...
>
|