Thread: excel and fun?
View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Lisa[_13_] Lisa[_13_] is offline
external usenet poster
 
Posts: 1
Default excel and fun?

Hi there Ken, sorry for the late reply but I've had some personal matters to
attend to. A friend of mine died and I didn't feel like being behind my pc.
Today I've tried your suggestions. The scrolling text works fine, but.. I
would like to show you the code I am using now and ask you if it is possible
to mix your code together with mine and get longer texts to scroll.

The smiling and sad faces do not work. I am pretty sure I am doing something
wrong but I cannot figure out what... I will try them again and let you know
all the steps I take and what I do exactely...

All the above only if it is alright with you

Thanks for you patience and help

"Ken Johnson" wrote in message
...
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