RE: Countdown timer

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

Hi J.
Just an update on this project.
I have noticed that if any other Excel workbook is open on the same pc, then
the countdown timer appears in I1 in the other workbooks too. Should any
workbook be open which has locked cells (ie I1), then the vba fails when that
worksheet gets focus.
If there is more that one excel book open, then clicking the tab in the task
bar to go to another does nothing. The only way to 'tab' between workbooks is
to use the 'Window' menu item and select a book from there. Should you try to
open another workbook, then nothing happens until the countdown timer code is
halted.
When the timer reaches 0, only the first opened workbook (with timer code)
closes down. The others remain open.

Is there a way to limit the code to one worhsheet only?

Thanks,

Jock


"JLatham" wrote:

Jock,
I've completely done away with your Application.OnTime setup and usage. The
save and close is done within the same routine that handles the display of
time remaining. The two processes were not playing well together at all, and
it really isn't needed with this new code. Also, you can do away with the
"SaveAndCloseMe" code, where ever it is in your workbook. It's no longer
used.

All New code - will display correct time remaining, and is 'smart' in
determining if it needs to display Hours and/or Minutes or just seconds.
I've set this up for 20 seconds for quick testing - you can change the 20 to
1200 for 20 minutes.

'----------
'goes into Workbook's code module
'
'declared here so that it
'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
'20 minutes: 60*20 = 1200
Const TimeAllowed = 20 '7260 = 2hrs 1min, 1200 = 20 minutes

Private Sub Workbook_Open()
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer > TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = ""
If TimeHrsRemaining > 0 Then
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
ElseIf TimeMinRemaining > 0 Then
TimeDisplay = TimeMinRemaining & "M " & _
TimeCalc & "s"
Else
TimeDisplay = TimeCalc & "s"
End If

TimeDisplay = TimeDisplay & _
" before automatic save & close."

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' display Time Remaining

TimePassed = Timer
End If
DoEvents
Loop
Range(DisplayTimeRemainingInCell) = "Saving and Closing"
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close

End Sub
'--------------------

"Jock" wrote:

Sorry, I forgot to paste the altered code on my last reply; here it is:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'20 minutes
'calculated as (60*20) = 1200
Const TimeAllowed = 60 '60 = 1 min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err <> 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer > TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

'TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour) Hours not used in this code

'TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour) Hours not used in this code

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeMinRemaining & "m " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub
--
tia

Jock

.

Relevant Pages

  • RE: Creating a Log
    ... > '** When workbook is opened triggers the start timer. ... > Dim TStart As Long 'Timer - Start ... > Private Sub Workbook_BeforeClose ...
    (microsoft.public.excel.programming)
  • Re: Creating a Log
    ... > '** When workbook is opened triggers the start timer. ... > Dim TStart As Long 'Timer - Start ... > Private Sub Workbook_BeforeClose ...
    (microsoft.public.excel.programming)
  • Re: First time Outlook VBA - Prob right-a-way
    ... If you want to display the workbook, you can set the Excel.Application object's Visible property to True and call the Workbook.Activate method. ... you may want to post your Excel-related questions in an Excel group. ... Dim xlApp As Excel.Application ...
    (microsoft.public.outlook.program_vba)
  • Re: Select from a list of workbooks that are open
    ... display a numbered list of open ... Sub AAA ... Dim S As String ... Dim WB As Workbook ...
    (microsoft.public.excel.programming)
  • Re: SQL access from Cobol Test
    ... Dim oWrite As System.IO.StreamWriter ... Dim workline As String ... 000380 01 NEW-GENERIC-REC. ... 000810 DISPLAY "INVALID READ FROM IMPORT TEXT FILE". ...
    (comp.lang.cobol)