change autoshape by condition from a cell value

Hi all,

I am trying to change in a help file an autoshape based on the value of
a cell.
If the cell say H19 is positive then I need a triangle suggesting a
descent, if is negative
I need a triangle which is suggesting a rise.

I try to use the following code to see how it works:

Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$H$19" And Target >= 0 Then
ActiveSheet.Shapes("AutoShape 48").Visible = True
Else
ActiveSheet.Shapes("AutoShape 48").Visible = False
End If
End Sub

The only problem is that my triangle (AutoShape 48) once disappear will
not came back when the condition changes.

I have very limited experience in programming and I would appreciate
any help.

emil

Hi emil,
I copied your code, pasted it into a spare sheet's code module, added a
triangle and named it "AutoShape 48". Then, after changing H19 to -1
the triangle disappeared and reappeared when I made H19 >=0.

So I don't know what you're doing wrong.

Ken Johnson

Hi Emil,
One possible cause is Application.EnableEvents could be equal to FALSE.
To see if this is the case type the following into the Immediate Window
of the VBA editor..

?Application.EnableEvents

After you then press Enter, if the word FALSE appears in the Immediate
Window then that is your problem. It should return TRUE.

To reset it to TRUE, type the following into the Immediate Window...

Application.EnableEvents=TRUE

then press Enter.

After that your code should work.

Ken Johnson

Hi Emil,

Hope you figure out what the problem is.

Meanwhile, just for FUN...

The following code lets you achieve the up/down arrow effect with the
ONE AutoShape...

Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$H$19" And Target >= 0 Then
ActiveSheet.Shapes("AutoShape 48").Rotation = 0
Else
ActiveSheet.Shapes("AutoShape 48").Rotation = 180
End If
End Sub

Hope this helps.

Ken Johnson

Thank you Ken!

I guess I am doing something wrong:
The way I write the code was:
right click on the sheet1 tab
selected view code
paste in the code
on top of that window there are Worksheet and next to it
SelectionChange

after the code I try the query: ?Application.EnableEvents
which after I hit enter returned: Print.Application.EnableEvents

Thank you for rotation tip. It is great!
The code works but the referencing cell $H$19 is a result of a
calculation (cos of another cell value).
It works only when I select this cell (click on it). As soon as I click
elsewhere the darn triangle flips back!

I change the reference in the code to a cell above where I type -1,
or +1. It works the same way: when I click elsewhere will flip back the
autoshape.

I think is something to do with event procedure (?) or other fancy
tricks, which are foreign to me (I am just a plain geologist!).
Can you please help me to make this code work independently of what
cell is selected.
One more question:
How I can change the name of an AutoShape? I am using Excel2000 and the
original file was created with ExcelXP. Since I have less Autoshape I
just copy and paste one. It has the same name (this time AutoShape 3)
like the first one. Sure enough only the original one flips while the
copy does not want to budge!.

Thanks again,
Emil

Hi Emil,
You must have rocks in your head;-)

>after the code I try the query: ?Application.EnableEvents<
>which after I hit enter returned: Print.Application.EnableEvents<

Sounds to me like you typed it in the Sheet1 code module instead of the
Immediate window. The confusion is understandable.
Control+G or View>Immediate window will both open the Immediate window.
In the Sheet1 code module ? is just shorthand for Print, explaining the
returned result.

However, it sounds like Disabled Events is not your problem. It could
just be the code's logic. I'm very good at getting the Boolean stuff
wrong, and it sometimes takes me a few attempts to sort things out.(I'm
only a plain high school science teacher)

>The code works but the referencing cell $H$19 is a result of a<
>calculation (cos of another cell value).<
>It works only when I select this cell (click on it). As soon as I click<
>elsewhere the darn triangle flips back!<

If you want the triangle up for H19>=0 and down for H19<0 then I would
say change...

If Target.Address = "$H$19" And Target >= 0 Then

to...

If Range("$H$19") >= 0 Then

Unless I'm mistaken, your code doesn't need to know which cell is the
target cell.


You can change a shape's name in the Name box, which is on the left
side of the Formula Bar. Just select the shape, click in the Name box,
type the new name then press enter. Two shapes on the same sheet can't
have the same name. If you select a shape, then try to give it the same
name as another shape on that sheet, then all that happens is the
original shape with that name is selected. Oddly though, if you
duplicate a shape its duplicate does have the same name, but your code
will ignore it.

When coding with shapes I like to use a meaningful name, declare the
shape as a Shape Object and Set it as an Object Variable. If your code
has to manipulate the shape a fair bit it makes your code easier to
write.

Using this code as an example, I would firstly draw then select the
triangle then type shpArrow in the Name box then press Enter.
Then I would set up the following Event Procedure..

Sub Worksheet_Change(ByVal Target As Range)
Dim shpArrow as Shape
Set shpArrow = Me.Shapes("shpArrow")
'Me is shorthand for the Sheet belonging to that code module
If Range("$H$19") >= 0 Then
shpArrow.Rotation = 0
Else
shpArrow.Rotation = 180
End If
End Sub

Hope this helps.

Let me know how you go.

Ken Johnson

Thank you professor!
It works like a charm.
Right now I am in mood to toggle a shpSadFace with shpHappyFace!

Thanks a lot!
Emil

Hi Emil,

You're welcome.
Thanks for the feedback.

Just for fun try out the "Geological Happy Face". The only thing that
makes it happy is when you type gold into A1 (not case sensitive).

1. On a spare sheet draw the smiley face AutoShape then change its name
in the name box to shpFace.

2. Paste this code into that sheet's code module...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target <> Range("A1") Then
Exit Sub
End If
Dim Mouth As Single
Dim dMouth As Single
Dim shpFace As Shape
Set shpFace = ActiveSheet.Shapes("shpFace")
Mouth = shpFace.Adjustments.Item(1)
dMouth = 0.0005
If UCase(Range("A1").Value) = "GOLD" Then
Do While Mouth <= 0.8111
shpFace.Adjustments.Item(1) = Mouth + dMouth
Calculate
Mouth = Mouth + dMouth
Loop
Else
Do While Mouth >= 0.718
shpFace.Adjustments.Item(1) = Mouth - dMouth
Calculate
Mouth = Mouth - dMouth
Loop
End If
End Sub

3. Type anyword other than gold into A1. You should see what it thinks
of that. Type gold in A1 and you should see it cheer up.

4. You can increase the speed of the animation by making dMouth bigger
and vice versa.

(Don't try it on a Mac running OSX the code doesn't work there. I do
most of my stuff on an old iMac running OS 9.2)

You could also have your arrow rotate between up and down using this
code...

Sub Worksheet_Change(ByVal Target As Range)
Dim shpArrow As Shape
Set shpArrow = Me.Shapes("shpArrow")
If Range("$H$19") >= 0 Then
Do While shpArrow.Rotation > 0
shpArrow.IncrementRotation -3
Calculate
Loop
Else
Do While shpArrow.Rotation < 180
shpArrow.IncrementRotation 3
Calculate
Loop
End If
End Sub

Slow down or speed up the rotation by decreasing or increasing the
IncrementRotation values, currently -3 and 3 (-1 and 1 for slowest)

Have fun!

Ken Johnson