Count down timer with shape

[remeng]

Hi Foks,

Got another shape question. I know I know! Yet another one from this guy?!

Ok so here is what I am trying to do. Inside a shape I'd like to show a count down timer for 10 seconds while there is a wait operation taking place. I need to use the wait operation due to a network lag issue between workbooks when saving on SharePoint.

I want the user to see the visual count down so they know something hasn't gone wrong.

Can use use a count down timer while a wait command is running? If not, what is the better method like DoEvent?

How can I make this work?

before you ask, yes I need to use a shape.

here is my general mess of code...

ZeroHour = TimeValue("0:00:10")

timer_value = Format((ZeroHour - Now), "hh:mm:ss")

ThisWorkbook.Sheets("menu").Shapes.Range(Array("time_shape")).TextFrame2.TextRange.Characters.Text = timer_value



Application.Wait (Now + TimeValue("0:00:10"))

Thank you for the continuing assistance,

Mike

 

[Andrzejek]

Modified code from Timer function

On a UserForm, place a [tt]CommandButton1[/tt] and a label [tt]lblInfo[/tt]:

Option Explicit

Private Sub CommandButton1_Click()
Dim PauseTime, Start, Finish, TotalTime

If (MsgBox("Press Yes to pause for 10 seconds", 4)) = vbYes Then
    PauseTime = 10    [green]' Set duration.[/green]
    Start = Timer    [green] ' Set start time.[/green]
    Do While Timer < Start + PauseTime
        DoEvents      [green]' Yield to other processes.[/green]
        lblInfo.Caption = PauseTime - CInt(Timer - Start)
    Loop
    Finish = Timer                [green]' Set end time.[/green]
    TotalTime = Finish - Start    [green]' Calculate total time.[/green]
    MsgBox "Paused for " & TotalTime & " seconds"
Else
    End
End If

End Sub

You can modify this code to count down on your Shape instead the Label

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[remeng]

Hi Andy,

I found this code that works for a cell value and tried to modify it for a shape. I get a error saying that macros may be disable in the WB.

This occurs here

 Application.OnTime interval, "timer"

Any ideas?

original code website Link

my full code

Sub test()

Dim interval, bob As Date


total_time = "00:00:10"

bob = ThisWorkbook.Sheets(1).Shapes.Range(Array("time_shape")).TextFrame2.TextRange.Characters.Text



ThisWorkbook.Sheets(1).Shapes.Range(Array("time_shape")).TextFrame2.TextRange.Characters.Text = total_time
 
 
    interval = Now + TimeValue("00:00:01")
    
    If bob = 0 Then
        
        bob = total_time
    
    Exit Sub
    
    Else
    
    bob = bob - TimeValue("00:00:01")
    
    Application.OnTime interval, "timer"
     
    End If


End Sub

Sub stop_timer()

Dim interval As Date
 
    Application.OnTime EarliestTime:=interval, Procedure:="timer", Schedule:=False
 
End Sub

 

[Andrzejek]

I tried the code from that link, not crazy about it. I ALWAYS use [tt]Option Explicit[/tt]
And in their code I cannot use breaks to see what's going on because I get an error: "Can't execute code in break mode" on the same line of code you crash :-(

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[remeng]

I'm getting the same thing... SKIPPPPP!!!!! LOL

Minor correction on the code. The first Sub should be Sub timer ()

 

[strongm]

>while there is a wait operation taking place.

How are you coding the wait operation? Bear in mind that, if you are using [tt]Application.Wait[/tt] then the single-threaded nature of Excel's VBA means all your V BA code stops running for the duration of the wait, and this includes timers.

You'd be best to break any monolithic wait down into smaller chunks, and update the countdown time during each chunk, e.g:

[blue]Public Sub example()
    WaitCountdown 5
 End Sub
 
 Public Sub WaitCountdown(seconds As Long)
    Dim lp As Long
        
    For lp = seconds To 0 Step -1
        ThisWorkbook.Sheets(1).Shapes.Range(Array("time_shape")).TextFrame2.TextRange.Characters.Text = Format(lp, "00:00:00")
        Application.Wait DateAdd("s", 1, Now)
    Next
 End Sub[/blue]

Note that Andy's code earlier takes much the same approach.

 

[remeng]

Hi strongm,

Thanks! That shows the shape counting down exactly like it should. Could you explain your code and what exactly it is doing?

For waitcountdown 5, how is the 5 second call out passed to the other macro? How does the 5 get read?

Also, If this is added to a longer section of code, will it actually "wait" the 5 seconds before it continues to the next operation?

I'm self taught so I'd like to understand for future use.

Thanks,

Mike

 

[strongm]

[blue]Public Sub example()
    WaitCountdown 5 [COLOR=green]' call Waitcountdown procedure, passing 5 as the parameter. See procedure comments for what this does[/color]
    MsgBox "I have paused for 5 seconds" [COLOR=green]' message should appear after 5 seconds, demonstrating the pause is real[/color]
 End Sub
 
[COLOR=green]' WaitCountdown
' Purpose:    Runs a countdown timer for a specified number of seconds
'             This is an example, and so the procedure displays the countdown
'             in a hard-coded shape
' Parameters: seconds - specifies the number of seconds we wish to run our countdown timer[/color]
Public Sub WaitCountdown(seconds As Long)
   Dim lp As Long [COLOR=green]' loop counter[/color]
       
  [COLOR=green]' We are doing a countdown, so set up our For...Next loop appropriately
  ' Start with maximum number of seconds, and reduce by 1 each time around the loop[/color]
  For lp = seconds To 0 Step -1
       [COLOR=green]' Update our shape to display the remaining amount of seconds (lp) in a standard time format[/color]
       ThisWorkbook.Sheets(1).Shapes.Range(Array("time_shape")).TextFrame2.TextRange.Characters.Text = Format(lp, "00:00:00")
       [COLOR=green]' Delay for (approx) 1 second (by waiting until current time plus 1 second)
       ' Note:  Wait method suspends all Microsoft Excel activity, so this prevents the user clicking on anything
       ' that might interrupt any background processes that have yet to complete.[/color]
       Application.Wait DateAdd("s", 1, Now)
   Next
End Sub[/blue]

 

[Andrzejek]

Side note:
[pre] WaitCountdown 5[/pre]
is the equivalent to
[pre] Call WaitCountdown(5)[/pre]
Both lines do the same, syntax is a personal preference.
I do prefer [tt]Call[/tt], but that's just me

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[remeng]

Hi Andy,

the WaitCountdown 5 was confusing me. Call WaitCountdown is what I normally use.

When you have WaitCountdown 5, how does VBA know that it is equal to 5 seconds?

Is it because it is in WaitCountdown (seconds as long), where Call WaitCountdown 5 = Call WaitCountdown (5) which is passed as WaitCountdown (5 seconds as long)?

Do I have that correctly?

Thanks,

Mike

 

[strongm]

https://docs.microsoft.com/en-us/of...g-started/calling-sub-and-function-procedures

 

[remeng]

Wow that is really slick. I'll need to remember that.

One last question with regards to the pass multiple values;

Call HouseCalc(380950, 49500)

Can you pass a variable result?

bob = 380950
fred = 49500

Call HouseCalc(bob, fred)

 

[Andrzejek]

Sure you can:

Sub Main() 
Dim bob As Single
Dim fred As Single

bob = 99800
fred = 43100 

HouseCalc bob, fred 

bob = 380950
fred = 49500

Call HouseCalc(bob, fred) 

End Sub

BTW, I wish Microsoft would use [tt]Option Explicit[/tt] in their code examples...
And be more specific, because not everybody may know that:[tt]
Sub HouseCalc(price As Single, wage As Single)[/tt]
is actually:[tt]
Public Sub HouseCalc(ByRef price As Single, ByRef wage As Single)[/tt]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[strongm]

You can also use named parameters. which also has the side effect that the order of the parameters is no longer important ...


so ...

[blue]Sub example()
    Dim bob As Single
    Dim fred As Single

    bob = 99800
    fred = 43100

    [COLOR=green]' all legit ...[/color]
    HouseCalc price:=bob, wage:=fred
    HouseCalc wage:=fred, price:=bob
    Call HouseCalc(price:=bob, wage:=fred)
    Call HouseCalc(wage:=fred, price:=bob)
    
End Sub[/blue]

 

[Andrzejek]

The use of named parameters was mentioned in the link, but I still prefer to have them in order, especially that intelisense will give you hints:

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[strongm]

Coo - you read all my link, Andy? Well done!

>I still prefer to have them in order
Each to their own. I almost never pass named parameters, just a personal habit.