?
Solved

I want to write a macro for a shape in Excel

Posted on 2007-11-16
9
Medium Priority
?
1,939 Views
Last Modified: 2011-09-20
I have this circle (shape) that i inserted in excel and I want to write a macro that changes the inside color of this shape. I tried recording while i did it and that didn't work, i tried to record me inserting a shape and that didn't work either. Any ideas..... Is this possible
0
Comment
Question by:tchristie33
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
9 Comments
 
LVL 10

Expert Comment

by:kacor
ID: 20301468
ActiveSheet.Shapes.AddShape(msoShapeOval, X0, Y0, 40, 40).Select
'to get the index of the last inserted shape
ShapesCount = ActiveSheet.Shapes.Count
'to color the circle
ActiveSheet.Shapes(ShapesCount).Fill.ForeColor.RGB = RGB(255,0,0)

I hope this help

wbr Janos
0
 
LVL 38

Expert Comment

by:jeverist
ID: 20301473
Hi tchristie33,

You can check for the circle by type and or name and set the Interior.Color property like this:

Sub ChangeShapeColor()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
    If shp.Type = msoAutoShape Then
        If shp.Name = "Oval 1" Then
            shp.DrawingObject.Interior.Color = vbRed ' Red
        End If
    End If
Next shp

End Sub

Jim
0
 
LVL 10

Expert Comment

by:kacor
ID: 20301680
If you place the
for x=0 to 255
for y=o to 255
for z=0 to 255
    RGB(x,y,z)
    Do
        If Application.Wait(Now + TimeValue("0:00:1")) Then Exit Do 'wait for 1 sec
    Loop
next
next
next
you can change the wait time according your needs
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 33

Expert Comment

by:Jeroen Rosink
ID: 20304986
Kacor,
you madea typo in your code, instead of using 0 you used o.
for y=o to 255


0
 
LVL 10

Expert Comment

by:kacor
ID: 20305135
roos01,

you have right, sorry.I wrote it into comment field. But this is tested

Sub ShapeColorChange()
Dim X As Integer, Y As Integer, Z As Integer, ShapesCount As Integer
Dim X0 As Integer, Y0 As Integer
    'Exit on Esc
    X0 = 100
    Y0 = 400
    ActiveSheet.Shapes.AddShape(msoShapeOval, X0, Y0, 40, 40).Select
    'to get the index of the last inserted shape
    ShapesCount = ActiveSheet.Shapes.Count
    'to color the circle
    For X = 0 To 255 Step 16
        For Y = 0 To 255 Step 16
            For Z = 0 To 255 Step 16
                ActiveSheet.Shapes(ShapesCount).Fill.ForeColor.RGB = RGB(X, Y, Z)
                Do
                    If Application.Wait(Now + TimeValue("0:00:1")) Then Exit Do 'wait for 1 sec
                Loop
            Next
        Next
    Next
End Sub

wbr Janos
0
 

Author Comment

by:tchristie33
ID: 20312464
I am going to have to perform this for a  few shapes in my workbook. I wan to select a shape that I have already created and named and then turn it a color based on the criteria of another cell. Thanks for the help

Sub Shape()
Sheets("Performance-Reliability").Select
Dim shp As Shape
Shapes("Oval 1").Select
If Range("a1") < 25 Then
shp.DrawingObject.Interior.Color = vbRed
End If
Shapes("Oval 1").Select
If Range("a1") > 25 Then
shp.DrawingObject.Interior.Color = vbGreen
End If
Shapes("Oval 1").Select
If Range("a1") = 25 Then
shp.DrawingObject.Interior.Color = vbYellow
End If
End Sub
0
 
LVL 10

Accepted Solution

by:
kacor earned 2000 total points
ID: 20314134
If you know the name of the shape ("YourShape") you can simply change it's color by:

ActiveSheet.Shapes("YourShape").Fill.ForeColor.RGB = RGB(Red,Green,Blue)

where each variable of Red, Green and Blue have a value between 0 to 255
0
 
LVL 10

Expert Comment

by:kacor
ID: 20314242
you can use the Select Case statement. Use it on the sheet's macro page

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim shp As Shape
    Sheets("Performance-Reliability").Select
    With ActiveSheet.Shapes("Oval 1").DrawingObject.Interior
    Select Case Cells(1, 1).Value
        Case Is < 25
            .Color = vbRed
        Case Is > 25
            .Color = vbGreen
        Case Else
            .Color = vbYellow
    End Select

End Sub
0
 

Author Closing Comment

by:tchristie33
ID: 31409648
I loved that it was easy and simple to understand
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

719 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question