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!!
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!!