countdown timer

[0lzi]

here is a picture to help visualise what im trying to do.

im trying to get the system time, then getting time from the user from inputbox, then display the difference in a shapes text box and loop untill the timeleft = 0

code i have so far:

Sub RoundedRectangle1_Click()

Dim setTimer
Dim currentTime
Dim timeLeft As Single

setTimer = InputBox("Please enter a Time seperated by : eg. hr:min:sec")

currentTime = Time

timeLeft = setTimer - currentTime

With ActiveSheet.Shapes("Rounded Rectangle 1") _
.TextFrame.Characters.Text = ("& timeLeft &")
End With

End Sub

i have not included a loop yet i am just wanting to display the time difference, between the two times.

 

[Andrew Poulsom]

This worked for me:

Sub RoundedRectangle1_Click()
    Dim setTimer
    Dim currentTime As Date
    Dim timeLeft As Date
    setTimer = InputBox("Please enter a Time seperated by : eg. hr:min:sec")
    currentTime = Time
    timeLeft = TimeValue(setTimer) - currentTime
    With ActiveSheet.Shapes("Rounded Rectangle 1")
        .TextFrame.Characters.Text = "(" & timeLeft & ")"
    End With
End Sub

 

[0lzi]

that worked but the text box shows the ( ) so i took them out, now i need to find out how to loop it,

im guessing i would have

do while timeLeft >0

or somthing?

any help on that?

 

[0lzi]

seems i need some help with my loops, this one seems to be an infinite loop as it crashes excel hard

code:

Sub RoundedRectangle1_Click()
    Dim setTimer
    Dim currentTime As Date
    Dim timeLeft As Date
    
    
    setTimer = InputBox("Please enter a Time seperated by : eg. hr:min:sec")
    currentTime = Time
    timeLeft = TimeValue(setTimer) - currentTime
   Do
    With ActiveSheet.Shapes("Rounded Rectangle 1")
        .TextFrame.Characters.Text = "" & timeLeft & ""
    End With
    Loop Until timeLeft >= ("00:00:00")
    
End Sub

 

[Andrew Poulsom]

Maybe you can adapt my solution here:

http://www.mrexcel.com/forum/showthread.php?t=31483

 

[0lzi]

i cant seem to get the text to update properly.

i have tried running another procedure that calls the "Sub RoundedRectangle1_Click()" but the problem is that it makes me enter the 'setTimer' value again

 

[Andrew Poulsom]

You need to set up an OnTime procedure not call the Click event procedure again.

 

[0lzi]

managed to do it slightly differently..

code:

Sub RoundedRectangle1_Click()
    Dim setTimer
    Dim currentTime As Date
   Dim timeLeft As Date
    
    setTimer = InputBox("Please enter a Time seperated by : eg. hr:min:sec")
    Do While timeLeft >= ("00:00:00")
    currentTime = Time
    timeLeft = TimeValue(setTimer) - currentTime
    With ActiveSheet.Shapes("Rounded Rectangle 1")
        .TextFrame.Characters.Text = "" & timeLeft & ""
    End With
    Application.Wait Now + TimeValue("00:00:01")
    
 Loop
    
End Sub

i just need to do an 'IF' in the loop that states, if the application close timeLeft = ("00:00:00") and that should break the loop right?

 

[Andrew Poulsom]

If you do it that way you won't be able to use your worksheet while the macro is running. Is that what you want?

 

[0lzi]

for now yes, i have just picked up doing vba for my job so im learning it its very different from the directX C++ stuff i did in uni, so programming isnt my weak point its just learning a different way of programming from OO C++ lol

thanks alot for your help,

im sure this forum will come in handy for my next little project for learning vba