excel and fun?
hello everybody, I have 2 questions:
1. my worksheets contain a macro that shows, randomly, some sentences in the status bar. I is possible to get the text to scroll allowing for longer texts) 2. I have this sheet in which, by means of simple calculations, my collegues and I can see if a target has been reached. I would love to be able to see something funny happening if the target is met (like a big smile or whatever) and also if the target is not met (an angry face). Is it possible to do so... and if it is...how? Thanks for all the support -- Lisa Save the Dogs Onlus - www.savethedogs.it |
excel and fun?
1.You could try singing along to this if you know the tune. Movement
is not all that smooth or steady and depending on the speed of your machine you might have to adjust the end value in the For Next loop... For I = 1 To 3000 DoEvents Next I make the 3000 larger to slow the scrolling or smaller to speed up. Public Sub ScrollStatus() Dim strMsg As String Dim strSubMsgs(1 To 13) As String Dim strDisplayMsg As String Dim OldStatusBar Dim K As Long, I As Long OldStatusBar = Application.StatusBar strSubMsgs(1) = " " strSubMsgs(2) = "When there's a shine on your shoes, " strSubMsgs(3) = "there's a melody in your heart, " strSubMsgs(4) = "with a singable happy feeling, " strSubMsgs(5) = "a wonderful way to start. " strSubMsgs(6) = "You'll find the world every day " strSubMsgs(7) = "with a deedle dum dee di di, " strSubMsgs(8) = "with a melody that is making " strSubMsgs(9) = "the worrying world go by. " strSubMsgs(10) = "When you walk down the street " strSubMsgs(11) = "with a happy-go-lucky beat, " strSubMsgs(12) = "you'll find a lot in what I'm repeating. " strSubMsgs(13) = "what a wonderful way to start the day." For I = 1 To 12 strMsg = strMsg & strSubMsgs(I) Next I For I = 2 To 3 strMsg = strMsg & strSubMsgs(I) Next I strMsg = strMsg & strSubMsgs(13) Do While K <= Len(strMsg) K = K + 1 strDisplayMsg = Mid(strMsg, K, 150) Application.StatusBar = strDisplayMsg For I = 1 To 3000 DoEvents Next I Loop Application.StatusBar = OldStatusBar End Sub 2. You could draw the SmileyFace AutoShape twice and adjust the mouth to be happy on one and sad on the other. Select the happy one then click in the Name Box on the left of the Formula Bar, type in Happy then press Enter. Repeat for the Sad one but type in Sad. Position them both near the the cell (A1 in my code) holding the value that is hopefully going to achieve the Target value (100 in my code). If they are identical size and shape and perfectly overlapping it will look like the one face with a changing smile. Then copy the following code, right click the sheet tab, choose "View code" and paste it into the sheet code module. The code runs every time the worksheet calculates. When A1 is greater than or equal to 100 the Happy face is visible while the Sad face is hidden, and vice versa when A1 is less than the Target value of 100. Private Sub Worksheet_Calculate() Const TargetValue As Single = 100 If Range("A1").Value < TargetValue Then Me.Shapes("Sad").Visible = True Me.Shapes("Happy").Visible = False Else: Me.Shapes("Sad").Visible = False Me.Shapes("Happy").Visible = True End If End Sub Ken Johnson |
excel and fun?
The code for Q2 can be simplified to...
Private Sub Worksheet_Calculate() Const TargetValue As Single = 100 Me.Shapes("Sad").Visible = Range("A1").Value < TargetValue Me.Shapes("Happy").Visible = Not Me.Shapes("Sad").Visible End Sub Ken Johnson |
excel and fun?
Hello Ken, I have tried both your answers but I get:
1. Compile error: Invalid outside procedure 2. There is no change in smiley when I change the value in the target cell. Plus.. can the target cell have a calculation in it (i.e. =IF(B290,IF(B29=B31,"YES","NO"),"") Thank you very much hello everybody, I have 2 questions: 1. my worksheets contain a macro that shows, randomly, some sentences in the status bar. I is possible to get the text to scroll allowing for longer texts) 2. I have this sheet in which, by means of simple calculations, my collegues and I can see if a target has been reached. I would love to be able to see something funny happening if the target is met (like a big smile or whatever) and also if the target is not met (an angry face). Is it possible to do so... and if it is...how? Thanks for all the support -- Lisa Save the Dogs Onlus - www.savethedogs.it |
excel and fun?
Hi Lisa,
1. Compile error: Invalid outside procedure... sounds like you have copied and pasted too much. Make sure when you copy the code that you start at... Public Sub ScrollStatus() and finish at... End Sub If you copy anything above "Public Sub ScrollStatus()" or below "End Sub" you will get the error message you mentioned. I suspect you have copied and pasted... For I = 1 To 3000 DoEvents Next I make the 3000 larger to slow the scrolling or smaller to speed up. which appears above "Public Sub ScrollStatus()" and this has caused the error. So just delete those lines and it should work. 2. There is no change in smiley when I change the value in the target cell. Plus.. can the target cell have a calculation in it (i.e. =IF(B290,IF(B29=B31,"YES","NO"),"") The code I supplied assumed the target value would be a number. Looking at your formula I'm guessing you would want the Happy face to appear when the formula returns "YES", Sad face to appear when the formula returns "NO" and neither face when "" is the returned value. If I'm correct then try... Private Sub Worksheet_Calculate() Dim rgTarget As Range 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"),"") With rgTarget Me.Shapes("Happy").Visible = .Value = "YES" Me.Shapes("Sad").Visible = .Value = "NO" End With End Sub Ken Johnson |
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 |
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 |
excel and fun?
Hi Lisa,
With sad news like that you really need a smiley face. I'll do what ever is needed to get both working the way you want, assuming my Excel skills are up to the task. If it's possible to send me a copy (or something similar) of the workbook(s) then please do. It's always easier working with actual workbooks than using one's imagination. You know how to get my email address from "View Profile"? Ken Johnson |
All times are GMT +1. The time now is 06:58 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com