Tom’s Tutorials For Excel: Programming Multiple Drawing Shapes
Here’s how you can assign one macro to multiple drawing shapes on your worksheet, and have them all behave uniquely, depending on which shape was clicked.
In the pictured example, four Oval drawing shapes were placed on the worksheet, keeping their default names of “Oval 1”, “Oval 2”, “Oval 3”, and “Oval 4” but changing their captions to “Quarter 1” and so on.. The same macro (posted below) was assigned to each Oval shape. When an Oval is clicked, its color becomes red for easier identification, and the other 3 Oval shapes become yellow, using RGB. Also, depending on the column location of the clicked Oval, the associated range of cells is selected.
Sub OvalColor()
Dim intOval As Integer
With ActiveSheet
For intOval = 1 To 4
.Shapes("Oval " & intOval).Fill.ForeColor.RGB = RGB(255, 255, 0)
Next intOval
With .Shapes(Application.Caller)
.Fill.ForeColor.RGB = RGB(255, 0, 0)
With .TopLeftCell
Range(Cells(5, .Column), Cells(22, .Column + 2)).Select
End With
End With
End With
End Sub
Cool. I modified your code and then tested — made a sheet with 4 ovals, selected all of them, rick-clicked on the selection, chose “Assign Macro…” from the shortcut menu
Rather than changing all the colors to not selected and flipping one of them, I added a test to check the oval name with the caller name. Also threw in a couple variables to make it easier to use in other applications. Here is my version:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub OvalColor() 'originally written by Tom Urtis 'http://www.atlaspm.com/toms-tutorials-for-excel/toms-tutorials-for-excel-programming-multiple-drawing-shapes/ 'modified by Crystal 121220 Dim intOval As Integer _ , nRow1 As Long _ , nRow2 As Long _ , nNumCols As Integer _ , nOvals As Integer _ , sCallerName As String nRow1 = 3 nRow2 = 8 nNumCols = 3 nOvals = 4 With ActiveSheet sCallerName = .Shapes(Application.Caller).Name For intOval = 1 To nOvals With .Shapes("Oval " & intOval) If .Name = sCallerName Then .Fill.ForeColor.RGB = RGB(255, 0, 0) 'red With .TopLeftCell Range(Cells(nRow1, .Column), Cells(nRow2, .Column + nNumCols - 1)).Select End With Else .Fill.ForeColor.RGB = RGB(255, 255, 0) 'yellow End If End With Next intOval End With End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~thanks, Tom
Warm Regards,
Crystal
*
(: have an awesome day 🙂
*
Hi Crystal, thanks for your comment and code! It looks like you arrived at the same color result for each oval (either yellwo or red) with a loop as I did , but you first looped through each oval to turn the one that was clicked red, and if not, make it yellow. That makes more sense than my code which loops through every oval first regardless, and then identifies the called shape for red. So my original code has that redundancy in it, which yours does not. Thanks for posting.
thanks, Tom 🙂
Warm Regards,
Crystal
free webcasts:
http://www.LearnByCrystal.com
*
(: have an awesome day 🙂
*
you’re welcome and thank you, Tom 🙂
Warm Regards,
Crystal
*
(: have an awesome day 🙂
*
Hi Tom,
Thanks again for this article. The esoteric VBA is something which I really look forward to.
Tried the code, but am getting an error at the beginning of the procedure which says:
System Error &H80070057 (-2147024809). The parameter is incorrect.
I assigned the macro to the shape and entered the code in “This Workbook” of the workbook I was working on. Can you tell me what I have missed / not done correctly.?
Thanks,
Adi
Actually it sounds like you did make a mistake, a small one easy to rectify. The mistake you made was placing the code in the ThisWorkbook module. Please remove the code from there, and paste it into a new standard module. For example, in the VBE, from the menu bar click Insert > Module and that is teh kind of module you’d want to place the code in. Aftar that, the macro should work as well for you as it did for me.
I am trying to draw a cross section in Excel 2007 using VBA and node coordinates. I can draw the cross section using the build Freeform Shape Command and then use ConvertToShape. It looks great but retangular. I provide the corner node coordinates (X & Y) and a radius for that corner (0 if no radius at the corner) in an worksheet. I would like to be able to draw the fillets or radii at the corners if they are provided. Not sure how to do this is VBA.
Thanks for your help.
Hi Mark – –
That’s a good question, and I’m on a client project at the moment but I’d like to help you get an answer quickly. May I suggest you try an excellent forum which is free, easy to sign up, no spam or anything (actually I contribute to that board as well). It’s at
http://www.mrexcel.com/forum/excel-questions/
Many Excel experts on hand to see your question and can chime in faster today and this week than I will be able to.