Tom’s Tutorials For Excel: Programming Multiple Drawing Shapes

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
Share Button
Posted in Tom's Tutorials for Excel
Tags: , , , , , , , , , , , ,
8 comments on “Tom’s Tutorials For Excel: Programming Multiple Drawing Shapes
  1. Crystal says:

    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 🙂
    *

    • Tom Urtis says:

      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.

  2. Crystal says:

    thanks, Tom 🙂

    Warm Regards,
    Crystal

    free webcasts:
    http://www.LearnByCrystal.com

    *
    (: have an awesome day 🙂
    *

  3. Crystal says:

    you’re welcome and thank you, Tom 🙂

    Warm Regards,
    Crystal

    *
    (: have an awesome day 🙂
    *

  4. Adi says:

    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

    • Tom Urtis says:

      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.

  5. Mark Gosnell says:

    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.

    • Tom Urtis says:

      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.

Leave a Reply to Adi Cancel reply

Your email address will not be published. Required fields are marked *

*