PC Review


Reply
Thread Tools Rate Thread

Colour Coded Shapes

 
 
brrahimah@yahoo.com
Guest
Posts: n/a
 
      24th Sep 2007
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...

 
Reply With Quote
 
 
 
 
Tim Williams
Guest
Posts: n/a
 
      24th Sep 2007
Give your shapes a meaningful name such as "oval_001", "oval_002" etc.

Link them all to the same macro and in the code use Application.Caller to
find which one was clicked.

Tim


<(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...
>



 
Reply With Quote
 
Peter T
Guest
Posts: n/a
 
      24th Sep 2007
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...
>



 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Colour coded drop down list AlFinsberg Microsoft Excel Misc 2 12th Mar 2009 11:50 AM
colour coded IDE connector? Joseph Storage Devices 3 11th Nov 2005 04:00 PM
rating cells 1-5 colour coded HOW? =?Utf-8?B?dHJlZXRvcDQw?= Microsoft Excel New Users 1 9th Aug 2005 12:03 PM
colour coded results =?Utf-8?B?RG93bmluZ0RldmVsb3BtZW50cw==?= Microsoft Access Forms 3 26th May 2005 05:19 PM
Re: Colour Coded Contacts Milly Staples [MVP - Outlook] Microsoft Outlook Contacts 0 7th Sep 2004 04:28 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 04:27 PM.