Thread: excel and fun?
View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Ken Johnson Ken Johnson is offline
external usenet poster
 
Posts: 1,073
Default excel and fun?

Hi Lisa,

This one's even more fun. Add a SmileyFace AutoShape to your sheet,
make sure it is selected then click in the Name Box, on the left of
the Formula Bar, and type "MyFace" (without the speech marks) then
press Enter (don't forget to press Enter like I often do).
Copy the code below then right click the worksheet tab, select "View
Code" from the popup menu then paste in the code.

My code assumes the cell with the formula resulting in YES, NO or
blank is A1, so make sure you change the A1 in that part of the
code...

Set rgTarget = Range("A1")<<< change to suit your formula cell.

Now every time the worksheet calculates the code runs, and if the
return value of your formula changes then you should see the smile
smoothly move to a full smile when the formula cell changes to "YES",
a straight mouth when it changes to blank and an up-side-down smile
when it changes to "NO".
You can alter the speed of the smile change by changing the value of
the Speed constant...

Const Speed As Single = 5<<increase or decrease to make faster or
slower respectively.

On my old machine 5 took 2.8 seconds.

Private Sub Worksheet_Calculate()
'Increase or decrease the value of the
'constant Speed to increase or decrease
'the time MyFace takes to change its smile
Const Speed As Single = 5
Dim MyFace As Shape
Dim rgTarget As Range
Dim MOODi As Single
Dim MOODf As Single
Dim MOOD_ChgDrn As Long
Set MyFace = Me.Shapes("MyFace")
Set rgTarget = Range("A1")
'change A1 to suit your situation.
'Change A1 to the address of the cell
'with the formula...
'=IF(B290,IF(B29=B31,"YES","NO"),"")
MOODi = MyFace.Adjustments.Item(1)
Select Case rgTarget.Value
Case "YES"
MOODf = 0.8111111
Case "NO"
MOODf = 0.7180555
Case Else
MOODf = 0.7645833
End Select
MOOD_ChgDrn = Sgn(Round(MOODf, 7) - Round(MOODi, 7))
Select Case MOOD_ChgDrn
Case 0
Exit Sub
Case 1
Do Until MOODi = MOODf
MOODi = MOODi + Speed / 10000
MyFace.Adjustments.Item(1) = MOODi
DoEvents
Loop

Case -1
Do Until MOODi <= MOODf
MOODi = MOODi - Speed / 10000
MyFace.Adjustments.Item(1) = MOODi
DoEvents
Loop
End Select
End Sub

Have Fun!

Ken Johnson