If no activity, display a UserForm; 10 seconds later close Workboo

R

ryguy7272

I’m trying to display a UserForm if there is no activity in a WB for 10
seconds (actual will be much longer; just testing 10 seconds). After 10
seconds I want the UserForm to be displayed. On the UserForm I have a small
timer. A timer is displayed in a label on the UserForm, and the timer counts
down. If the user does not click cmdStop in 10 seconds, the UserForm will be
shut down and any prior changes will be saved and the WB will be closed.
Chip Pearson helped me with some of this code 1 week ago.

Now, all the parts of this scenario were working yesterday, albeit in
separate files. Now that I’ve blended everything together, it is NOT
working.

What do I need to do to make this work?

Code in Module1:
'In VBA, go to the Tools menu, choose References, and then Windows Script
Host Object Model.
Public CloseDownTime As Variant

Public Const nCount As Long = 10 ' secs
Public nTime As Double
Option Explicit

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
ResetTimer
End Sub

Public Sub RunTimer()
If nTime > 1 Then

nTime = nTime - 1
UserForm1.lblCountdown.Caption = Format(TimeSerial(0, 0, nTime),
"hh:mm:ss")
Application.OnTime Now + TimeSerial(0, 0, 1), "RunTimer"
Else
Unload UserForm1
Application.Windows(1).Activate
Sheets("Sheet1").Select
End If
End Sub

Code Behind Sheet:
Public CloseDownTime As Variant

'Set reference to Windows Script Host Object Model.
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime
EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:00:10") ' hh:mm:ss
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub

Public Sub CloseDownFile()
On Error Resume Next

With New IWshRuntimeLibrary.WshShell
UserForm1.Show
End With

ThisWorkbook.Close SaveChanges:=True
End Sub



Code Behind UserForm1:
Private Sub cmdStop_Click()
Unload UserForm1
nTime = 0
Sheets("Sheet1").Select
End Sub

Private Sub UserForm_Activate()
nTime = nCount
Call RunTimer
End Sub

The UserForm has a button named cmdStop and a label named lblCountdown.

Thanks!!
 
T

Tom Hutchins

(untested) Shouldn't the Workbook_ events be in the ThisWorkbook module
instead of Module1?

Hope this helps,

Hutch
 
R

ryguy7272

It is, Tom. Somehow my post went a little wacky.
Code in Module1:
Option Explicit
Public CloseDownTime As Variant
Public Const nCount As Long = 10 ' secs
Public nTime As Double

'Set reference to Windows Script Host Object Model.
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime
EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:00:10") ' hh:mm:ss
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub

Public Sub CloseDownFile()
On Error Resume Next
With New IWshRuntimeLibrary.WshShell
Unload UserForm1
End With
ThisWorkbook.Close SaveChanges:=True
End Sub

Public Sub RunTimer()
If nTime > 1 Then
nTime = nTime - 1
UserForm1.lblCountdown.Caption = Format(TimeSerial(0, 0, nTime),
"hh:mm:ss")
Application.OnTime Now + TimeSerial(0, 0, 1), "RunTimer"
Else
Unload UserForm1
Application.Windows(1).Activate
Sheets("Sheet1").Select
End If
End Sub


Code Behind Sheet1:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
ResetTimer
End Sub


Code Behind UserForm1:
Private Sub cmdStop_Click()
Unload UserForm1
nTime = 0
Sheets("Sheet1").Select
End Sub

Private Sub UserForm_Activate()
nTime = nCount
Call RunTimer
End Sub
 
T

Tom Hutchins

You new post says the Workbook_ events are behind Sheet1. Shouldn't they be
in ThisWorkbook?

Hutch
 
R

ryguy7272

That was it!! Funny how you can overlook the simplest things.

There is one more tiny change:
Public Sub CloseDownFile()
On Error Resume Next
With New IWshRuntimeLibrary.WshShell
UserForm1.Show
End With
ThisWorkbook.Close SaveChanges:=True
End Sub

Thanks Tom!!!
 

Ask a Question

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.

Ask a Question

Top