JLatham said:Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.
Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
'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
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub
JLatham said:Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.
JLatham said:Jock, I believe this will do it for you.
Just replace your existing code in the Workbook code module with the code
below. Notice that one Const is declared outside of the Sub codes. That is
so it can be declared once and and then referenced by any/all Sub/Functions
in that code module. It's referenced in two routines now. That is the
definition of the cell where you want the time remaining to be displayed on
the worksheet(s). I've got it set to $C$1 now, just change it to the correct
cell address for your use. The countdown is set to 2hrs 1 min just like your
event is set for.
I created Const values for everything you might need to change and placed
them into the declarations section so that you can change them one time in
the code and any place else in the code that needs them will automatically be
updated with the new values, that includes a new definition for the
"02:01:00" you use in setting up the workbook save/close timed task.
When you change that $C$1 entry, be certain to use absolute addressing (the
$ signs) before the column identifier and row number in the address. The
code tests to see if a worksheet change took place in that cell and it uses
that form of addressing. We have to ignore changes to worksheet in that cell
because if we don't then the Workbook_SheetChange() event would reset that
countdown to the beginning every second. The test prevents that from
happening.
As is noted in the code, once this gets going, which it's going to do either
when you open the workbook or when you make a change on any worksheet, then
it runs forever. So if you have to go into the code module to make changes,
it will still be running. In order to make any code changes, you'll have to
stop the process - once you get into the VB Editor, either just click the
[Reset] icon (small square as on a VCR/CD/DVD player to STOP play) or use Run
| Reset from the VB menu toolbar.
If you have any questions or need more assistance, either post here, or if
it is of nature that the information/question won't really serve to assist
others here, you can email me at [remove spaces] HelpFrom @ JLathamsite.com
If you need, I can even make a working copy of my file here available to you
for download from my site.
The new code - just cut and paste over the existing code for these two
workbook events:
'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 = "$C$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
Const TimeAllowed = 7260 '7260 = 2hrs 1min
'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "02: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)
TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)
TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)
TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
End Sub
Jock said:All help is very much appreciated.
Jock said:J.
That is fantastic. Thank you very much for yourtime and effort in helping me
with this. You obviously enjoy a challenge.
One final thing. I have tweaked it slightly, moved the display cell to $I$1
and removed the hours part (as I intend to limit the workbook to 20 mins
inactivity before shutdown) but, if poss, I would like the words 'before
automatic save & close' to appear in I1 after the timer display (it's a very
wide cell).
Thanks in advance
Jock
JLatham said:Jock, I believe this will do it for you.
Just replace your existing code in the Workbook code module with the code
below. Notice that one Const is declared outside of the Sub codes. That is
so it can be declared once and and then referenced by any/all Sub/Functions
in that code module. It's referenced in two routines now. That is the
definition of the cell where you want the time remaining to be displayed on
the worksheet(s). I've got it set to $C$1 now, just change it to the correct
cell address for your use. The countdown is set to 2hrs 1 min just like your
event is set for.
I created Const values for everything you might need to change and placed
them into the declarations section so that you can change them one time in
the code and any place else in the code that needs them will automatically be
updated with the new values, that includes a new definition for the
"02:01:00" you use in setting up the workbook save/close timed task.
When you change that $C$1 entry, be certain to use absolute addressing (the
$ signs) before the column identifier and row number in the address. The
code tests to see if a worksheet change took place in that cell and it uses
that form of addressing. We have to ignore changes to worksheet in that cell
because if we don't then the Workbook_SheetChange() event would reset that
countdown to the beginning every second. The test prevents that from
happening.
As is noted in the code, once this gets going, which it's going to do either
when you open the workbook or when you make a change on any worksheet, then
it runs forever. So if you have to go into the code module to make changes,
it will still be running. In order to make any code changes, you'll have to
stop the process - once you get into the VB Editor, either just click the
[Reset] icon (small square as on a VCR/CD/DVD player to STOP play) or use Run
| Reset from the VB menu toolbar.
If you have any questions or need more assistance, either post here, or if
it is of nature that the information/question won't really serve to assist
others here, you can email me at [remove spaces] HelpFrom @ JLathamsite.com
If you need, I can even make a working copy of my file here available to you
for download from my site.
The new code - just cut and paste over the existing code for these two
workbook events:
'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 = "$C$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
Const TimeAllowed = 7260 '7260 = 2hrs 1min
'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "02: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)
TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)
TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)
TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
End Sub
Jock said:All help is very much appreciated.
--
tia
Jock
:
Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.
:
JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.
Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub
This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia
Jock
:
Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.
:
Thanks, I'll give it a try
--
tia
Jock
:
Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.
Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
'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
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub
:
I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
Jock said:Hi again,
Slight problem that when the counter reaches 1 sec, it stops there and
doesn't shut down the workbook. I have changed it to one minute just for
evaluation purposes. Could it be the changes I've made? (see code below). If
I input something in a worksheet though, the timer starts again.
Help!!
lol
--
tia
Jock
Jock said:J.
That is fantastic. Thank you very much for yourtime and effort in helping me
with this. You obviously enjoy a challenge.
One final thing. I have tweaked it slightly, moved the display cell to $I$1
and removed the hours part (as I intend to limit the workbook to 20 mins
inactivity before shutdown) but, if poss, I would like the words 'before
automatic save & close' to appear in I1 after the timer display (it's a very
wide cell).
Thanks in advance
Jock
JLatham said:Jock, I believe this will do it for you.
Just replace your existing code in the Workbook code module with the code
below. Notice that one Const is declared outside of the Sub codes. That is
so it can be declared once and and then referenced by any/all Sub/Functions
in that code module. It's referenced in two routines now. That is the
definition of the cell where you want the time remaining to be displayed on
the worksheet(s). I've got it set to $C$1 now, just change it to the correct
cell address for your use. The countdown is set to 2hrs 1 min just like your
event is set for.
I created Const values for everything you might need to change and placed
them into the declarations section so that you can change them one time in
the code and any place else in the code that needs them will automatically be
updated with the new values, that includes a new definition for the
"02:01:00" you use in setting up the workbook save/close timed task.
When you change that $C$1 entry, be certain to use absolute addressing (the
$ signs) before the column identifier and row number in the address. The
code tests to see if a worksheet change took place in that cell and it uses
that form of addressing. We have to ignore changes to worksheet in that cell
because if we don't then the Workbook_SheetChange() event would reset that
countdown to the beginning every second. The test prevents that from
happening.
As is noted in the code, once this gets going, which it's going to do either
when you open the workbook or when you make a change on any worksheet, then
it runs forever. So if you have to go into the code module to make changes,
it will still be running. In order to make any code changes, you'll have to
stop the process - once you get into the VB Editor, either just click the
[Reset] icon (small square as on a VCR/CD/DVD player to STOP play) or use Run
| Reset from the VB menu toolbar.
If you have any questions or need more assistance, either post here, or if
it is of nature that the information/question won't really serve to assist
others here, you can email me at [remove spaces] HelpFrom @ JLathamsite.com
If you need, I can even make a working copy of my file here available to you
for download from my site.
The new code - just cut and paste over the existing code for these two
workbook events:
'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 = "$C$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
Const TimeAllowed = 7260 '7260 = 2hrs 1min
'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "02: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)
TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)
TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)
TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
End Sub
:
All help is very much appreciated.
--
tia
Jock
:
Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.
:
JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.
Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub
This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia
Jock
:
Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.
:
Thanks, I'll give it a try
--
tia
Jock
:
Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.
Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
'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
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub
:
I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
Jock said: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
JLatham said: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 said: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
Jock said:J
Absolutely brilliant! Many thanks for your effrorts here, they are very much
appreciated. Appologies for the late response (bank holiday here)
Thanks again.
--
tia
Jock
JLatham said: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 said: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
JLatham said: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 said: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
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.