PDA

View Full Version : Solved: OnTime events with Userforms



magelan
03-14-2013, 02:26 PM
Hi all. Here's my code.

Userform named "timeoutForm"


Private Sub cbCloseDontSave_Click()
Call closeDontSave
End Sub

Private Sub cbResume_Click()
Call resumeWork
End Sub

Private Sub cbSaveClose_Click()
Call saveClose
End Sub

Private Sub UserForm_initialize()
Dim timeString As String
Dim i As Integer

For i = 0 To 30
If i < 10 Then
timeString = "00:00:0" & i
Else
timeString = "00:00:" & i
End If
Application.OnTime Now + TimeValue(timeString), "timeoutForm.updateLabel(i)"
Next
Application.OnTime Now + TimeValue("00:00:31"), "Timeoutform.saveClose"
End Sub

Private Sub saveClose()
MsgBox "Saved and Closed"
End Sub

Private Sub closeDontSave()
MsgBox "Closed without Saving"
End Sub

Private Sub resumeWork()
MsgBox "Resuming Work"
End Sub

Private Sub updateLabel(timeSub As Integer)
lbTimeDynamic.Caption = "Workbook will automatically save and close in " & 30 - timeSub & " seconds..."
End Sub



module named timeModule


Sub warnTime()
timeoutForm.Show
End Sub


thisWorkbook


Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:10"), "timeModule.warnTime"
End Sub



You'll notice i have my time set to 10 seconds, this is for testing.

I do however, want to display a userform with a countdown that will go 30, 29 28 27 26... and then have my three buttons [resume, save, close]

How do i go about making the call for OnTime in the userform? As you can see, I have a loop build my 30 label changes and set them one second apart, and I also pass I to my Label changer to do 30-i = new time... so the math is correct.

However, the form comes up, doesnt do anything. When I close the form, 30 message boxes come u psaying "cannot find procedure timeForm.updateLabel(i)

SamT
03-14-2013, 06:13 PM
I'm not sure but I think you will have to declare i as a module level variable, ie; before the first sub.

Use OnTime to call updateLabel without arguments and Use the module variable "i" internally to udateLabel.
Application.OnTime Now + TimeValue(timeString), "timeoutForm.updateLabel" Private Sub updateLabel()
lbTimeDynamic.Caption = "Workbook will automatically save and close in " & 30 - i & " seconds..."
End Sub

GTO
03-14-2013, 09:55 PM
Hi there,

I'm not so sure you can use OnTime to call a procedure in a Form's module. Granted, the form is loaded, and OnTime or Run will get to code in a Worksheet's module, but at least in the several tries I made, it wouldn't go.

Anyways, it would seem a lot easier to just call procedure(s) in a Standard Module - so see if this is at least in the general direction you are looking to go...

In the Form's Module:
Option Explicit

Private Sub cbCloseDontSave_Click()
KillOnTime
End Sub

Private Sub cbResume_Click()
KillOnTime
Module1.StartIt 1, 10
End Sub

Private Sub cbSaveClose_Click()
Unload Me
End Sub

Private Sub UserForm_Activate()
Module1.StartIt 1, 10
End Sub

In a Standard Module (named Module1):
Option Explicit

Private lRunHowLong As Long '<--- Store remaining time
Private NextRunTime As Double '<--- Next time to run procedure, stored, so we can cancel OnTime
Private Delay As Long '<--- How long delay in whole seconds

Public Sub MyButtonPushed()
timeoutForm.Show
End Sub

Public Sub StartIt(PrimeDelay As Long, Runtime As Long)
'// Assign values to our module level variables and start things up //
lRunHowLong = Runtime
Delay = PrimeDelay
PrimeOnTime
End Sub

Public Sub PrimeOnTime()
Dim sArg As String

'// Reset the next time to run //
NextRunTime = Now + TimeSerial(0&, 0&, CLng(Delay))
'// Build the procedure called argument //
sArg = ThisWorkbook.Name & "!" & "'Module1.UpdateLabel'"
Application.OnTime NextRunTime, sArg, , True
End Sub

Public Sub KillOnTime()
Dim sArg As String

sArg = ThisWorkbook.Name & "!" & "'Module1.UpdateLabel'"
'// Resume Next just in case no current timer exists, then kill existing. //
On Error Resume Next
Application.OnTime NextRunTime, sArg, , False
On Error GoTo 0
'// reset stuff //
lRunHowLong = 0
NextRunTime = 0
Delay = 0
End Sub

Private Sub UpdateLabel()
'// Adjust remaining time //
lRunHowLong = lRunHowLong - Delay
'// Since we are in a Standard Module, I think we want to make sure //
'// the Object Module (the Form's module) is still accessible. //
If FormIsLoaded("timeoutForm") Then

timeoutForm.lbTimeDynamic.Caption = _
"Workbook will automatically save and close in " & lRunHowLong & " seconds..."

If lRunHowLong <= 0 Then
Unload timeoutForm
Else
PrimeOnTime
End If
End If
End Sub

Function FormIsLoaded(FormName As String) As Boolean
Dim UF As MSForms.UserForm
Dim n As Long

For n = 0 To UserForms.Count - 1
If UserForms(n).Name = FormName Then
FormIsLoaded = True
Exit Function
End If
Next
End Function

Hope that helps,

Mark

magelan
03-21-2013, 02:27 PM
Hi there,


Mark
Well this ALMOST worked...the only problem is that when I automatically load this using the workbook_open event, it wont start counting in the userform =(

from ThisWorkbook module


Private Sub Workbook_Open()
Call startTimeModule
End Sub

Sub resetTimer()
Call Workbook_Open
End Sub


from timerModule [module 1]


Option Explicit

Private lRunHowLong As Long '<--- Store remaining time
Private NextRunTime As Double '<--- Next time to run procedure, stored, so we can cancel OnTime
Private Delay As Long '<--- How long delay in whole seconds

Public Sub startTimeModule()
'Application.OnTime Now + TimeValue("00:00:05"), "timermodule.timeouthappened"
End Sub

Public Sub timeOutHappened()
timeoutForm.Show
End Sub

Public Sub StartIt(PrimeDelay As Long, Runtime As Long)
'// Assign values to our module level variables and start things up //
lRunHowLong = Runtime
Delay = PrimeDelay
PrimeOnTime
End Sub

Public Sub PrimeOnTime()
Dim sArg As String

'// Reset the next time to run //
NextRunTime = Now + TimeSerial(0&, 0&, CLng(Delay))
'// Build the procedure called argument //
sArg = ThisWorkbook.Name & "!" & "'Module1.UpdateLabel'"
Application.OnTime NextRunTime, sArg, , True
End Sub

Public Sub KillOnTime()
Dim sArg As String

sArg = ThisWorkbook.Name & "!" & "'Module1.UpdateLabel'"
'// Resume Next just in case no current timer exists, then kill existing. //
On Error Resume Next
Application.OnTime NextRunTime, sArg, , False
On Error GoTo 0
'// reset stuff //
lRunHowLong = 0
NextRunTime = 0
Delay = 0
End Sub

Private Sub UpdateLabel()
'// Adjust remaining time //
lRunHowLong = lRunHowLong - Delay
'// Since we are in a Standard Module, I think we want to make sure //
'// the Object Module (the Form's module) is still accessible. //
If FormIsLoaded("timeoutForm") Then

timeoutForm.lbTimeDec.Caption = _
"Workbook will automatically Save & Exit in " & lRunHowLong & " seconds..."

If lRunHowLong <= 0 Then
Unload timeoutForm
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
PrimeOnTime
End If
End If
End Sub

Function FormIsLoaded(FormName As String) As Boolean
Dim UF As MSForms.UserForm
Dim n As Long

For n = 0 To UserForms.Count - 1
If UserForms(n).Name = FormName Then
FormIsLoaded = True
Exit Function
End If
Next
End Function


in timeoutForm [userform 1]


Option Explicit

Private Sub cbDontSave_Click()
KillOnTime
Unload Me
Application.DisplayAlerts = False
ActiveWorkbook.Close 'dont save, quit
End Sub

Private Sub cbResume_Click()
KillOnTime 'kill the timer for expiration
Unload Me 'unload form
Call ThisWorkbook.open 'restart the large timer
End Sub

Private Sub cbSave_Click()
KillOnTime
Unload Me
Application.DisplayAlerts = False
ActiveWorkbook.Save 'save
ActiveWorkbook.Close 'and quit
End Sub

Private Sub UserForm_Activate()
'change this variables value in order to set how long
'the messagebox is displayed.
Dim expirationTimer As Long
expirationTimer = 30
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

timerModule.StartIt 1, expirationTimer
End Sub

GTO
03-21-2013, 04:30 PM
After stripping any sensitive info, attach your workbook with the code as you now have it.

Thanks,

Mark

magelan
03-25-2013, 07:03 AM
After stripping any sensitive info, attach your workbook with the code as you now have it.

Thanks,

Mark

Here you go Eeyore, i've commented out the code execution start in Workbook_Open so that you wont get spammed every 5 seconds by the dialog. It will be pushed out to 10 minutes in the final.

magelan
03-25-2013, 02:16 PM
I found my issue. In the "PrimeOnTime" subroutine I had a reference to Module1 and I had changed my module name to TimerModule.

Solved.