I am using an Excel file with an Userform to control how long it takes for some people to complete a set of tasks.
I have an Userform that opens on start up and as soon as you click the button on it, the time starts counting. However, I don't really understand how I can do that.
I need the timer to run until the task is complete and the user clicks "Exit" or "Complete" and then save the time to my spreadsheet.
I propose slightly different approach. In the userform, declare variables:
Private startTime As Double
Private endTime As Double
Private blTime As Boolean
blTime is double that tells the application that the clock goes on. Then set value for startTime when userform is launched:
Private Sub UserForm_Initialize()
startime = Time
blTime = True
End Sub
I have assumed thet your button complete control is named cbComplete. Change to your button's real name
Private Sub cbComplete_Click()
If blTime Then endTime = Time
blTime = False
End Sub
The clock is turn off (blTime = False) when user click the button. You can add analogous code for other buttons as well but only the first click matters.
What we need is a way to get time that lapsed from the form. Use property:
Property Get Timespan() As Double
If Not blTime Then
Timespan = endTime - startTime
Else
Timespan = 0
End Property
Then, in module you can use command UserForm1.Timespan. Or format it nicely:
Format(UserForm1.Timespan, "hh:mm:dd")
Important: UserForm cannot be .Unload before, just .Hide.
You could adapt something like this:
Sub CalculateRunTime_Minutes()
'PURPOSE: Determine how many minutes it took for code to completely run
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Insert Your Code Here...
'*****************************
'Determine how many seconds code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub
To suit your needs. Source is here
You can learn more about VBA's Timer function here
A second option would be to use the Now function which will give you the current time. So for example:
t = Now
.... run your tasks....
tfinal = Now
time_elapsed = tfinal - t
Related
I am trying to create a countdown timer in word.
While running the code i am getting "Runtime error '70': permission denied" for a line in the code: time = time + TimeValue("00:00:01") in modtimer module.
I have created a userform and a separate module named modtimer, the code is given below:
The word document code: (ThisDocument) to show timer when word document opens
Sub Document_Open()
UserForm1.time_left.Visible = False
UserForm1.Label1.Visible = False
UserForm1.Show
End Sub
The code given in userform is as follows:
Dim g_start As Variant
Dim start As Variant
Dim timeEnd As Variant
Dim g_time As Variant
Dim time As Variant
Dim g_timeEnd As Variant
Dim time_duration As Variant
Dim g_time_duration As Variant
Dim g_End As Boolean
Private Sub btnStart_Click()
start = Now
g_start = Format(start, "hh:mm:ss")
timeEnd = Now + TimeValue("00:30:00")
g_timeEnd = Format(timeEnd, "hh:mm:ss")
time_duration = timeEnd - start
g_time_duration = Format(time_duration, "hh:mm:ss")
Label1.Visible = True
time_left.Caption = g_time_duration
time_left.Visible = True
btnStart.Visible = False
time = start + TimeValue("00:00:01")
time_duration = timeEnd - time
g_time_duration = Format(time_duration, "hh:mm:ss")
time_left.Caption = g_time_duration
modtimer.time_count
End Sub
The module code is as follows:
Sub time_count()
If time_duration = TimeValue("00:05:00") Then
MsgBox "Only 5 minutes remaining", vbInformation
End If
time = time + TimeValue("00:00:01")
time_duration = timeEnd - time
If time_duration = TimeValue("00:00:00") Then
g_End = True
End_Exam
End If
'If g_End = True Then
' End_Exam
'End If
g_time_duration = Format(time_duration, "hh:mm:ss")
time_left.Caption = g_time_duration
Call time_count
End Sub
Sub End_Exam()
MsgBox "Examination Time has Expired, Click Ok to Submit", vbCritical
'Documents.Save False, wdOriginalDocumentFormat
Documents.Close wdPromptToSaveChanges, wdPromptUser
End Sub
What is the reason behind it? Can anybody help?
Time is a vba function (and also a vba statement btw).
It is not a good idea to define a variable with the same name.
In your userform, you are overloading the function with your variable, but in the module every time you use Time your are referring to the standard Function (or statement), not the variable from the userform.
By the way, variables in userforms are private by default, so you cannot access the time variable in the userform from the module, you need to specify Public instead of Dim.
Once the variable is Public, you will be able to access it but you will need to use Userform1.time instead of only time.
But it still isn't a good idea to name it time
Additional explanation:
In the module, in the line
time = time + TimeValue("00:00:01")
The first time is the time statement (to change system time)
The second time is the time function (returns current time)
So you are trying to set the system time to the current time + 1 second.
This operation can be done only if you have elevated rights, hence the Runtime error '70': permission denied you get.
Time is an VBA property, and it is read-only (it gives simple the actual time). If you need a variable, use a different name.
I am trying to work out how to get my progress bar to show the progress of the subroutine below. Does anyone have any ideas how to get the ball rolling on this one?
Any help or advice is appreciated.
Private Sub CommandButton8_Click()
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Direct Data
Sheet4.Activate
Call Test1
Call Test2
Call Test3
Call Test4
'Return to Welcome Page
Sheet8.Activate
'*****************************
'Determine how many seconds the code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes",
vbInformation
End Sub
Here's what I use for a progress bar:
Application.StatusBar = "Processing... " & CInt(nRow / nLastRow * 100) & "% " & String(CInt(nRow / nLastRow * 100), ChrW(9609))
DoEvents ' optional
nRow is the increment number
nLastRow is the value for 100% complete
When the loop is complete, reset it like this:
Application.StatusBar = ""
The logic behind a progressbar is this:
have a userform with a Label (or image or button) with the image of your example photo. Put it in a frame. The width of the frame is initialised to zero and grows as your number grows by either calling a Public Sub inside the userform, of directly Userform1.Frame1.width=Percent*MaxWidth/100.
Sometime you would want to add a doevents, wich i use only every X cycles (if clng(percent) mod X = 0 then doevents , for example).
Step 1: design a progress dialog box. For the following example, it must have the name frmProgress and have two text labels lblMsg1 and lblMsg2
Step 2: insert the following code in the dialog's code module:
Sub ShowProgressBox()
Me.Show vbModeless
End Sub
Sub SetProgressMsg(msg1, msg2)
If (msg1 <> "") Then Me.lblMsg1 = msg1
If (msg2 <> "") Then Me.lblMsg2 = msg2
DoEvents
End Sub
Sub SetProgressTitle(title)
Me.Caption = title
DoEvents
End Sub
Sub EndProgressBox()
Unload Me
End Sub
You can call these functions from your code to show progress messages.
Step 3: in your code, at the beginning of the lengthy operation, call
frmProgress.ShowProgressBox
Step 4: during the lengthy operation, regularly call the set function to show the user information, for example in a loop:
frmProgress.SetProgressMsg "Searching in "+ myArray(i), "Working..."
Step 5: Once done, close the progress box:
frmProgress.EndProgressBox
I'm programming a sort of cross-reference database. An ID is generated based on the document name chosen or created.
The ComboBox I've referred to in the title acts on change (after 3 letters), checks the database for similar entries to what was typed, and displays the drop downof options that match. Once an entry is picked from the match list or a new name created - the appropriate number is generated.
Since the DropDown list is generated after every letter is typed, it takes a while to type what you want. I want to wait a few seconds after the last change to run the macro.
Any Ideas on how I can accomplish this?
An alternative using Application.OnTime again:
In Userform:
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
StartTimer
End Sub
In Module:
Public RunTime As Double
Public Sub StartTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunTime, Procedure:="YourCode", Schedule:=False
RunTime = Now() + TimeValue("00:00:03")
Application.OnTime RunTime, "YourCode"
End Sub
Public Sub YourCode()
MsgBox "It's working!"
End Sub
This is a bit tricky as VBA doesn't support multi-threading. But we can use the Application.OnTime event to trigger a test in the future to test if the last key event is at least 3 seconds ago.
In a Module insert:
Option Explicit
Public LastKeyEvent As Date
Public Const WaitTimeValue As String = "00:00:03" 'test for key event in 3 seconds
Public Sub TestKeyEvent()
'test if last key event is at least 3 seconds ago.
'If so: run your search or message box
'If not: do nothing
If LastKeyEvent <> 0 And LastKeyEvent + TimeValue(WaitTimeValue) <= Now Then
LastKeyEvent = 0 'Ensure this is only triggered once:
'If we don't do this and multiple keys are pressed within 1 second
'then it would run multiple times.
MsgBox "3 seconds without keypress, we can start search"
'start your search here (instead of message box) …
End If
End Sub
Now you can use for your textbox change event eg TextBox1:
Private Sub TextBox1_Change()
Dim alertTime As Date
LastKeyEvent = Now 'remember when the last key event was
alertTime = LastKeyEvent + TimeValue(WaitTimeValue)
Application.OnTime alertTime, "TestKeyEvent" 'run TestKeyEvent in 3 seconds
End Sub
Note:
This is a workaround that works for 2 or more seconds. But does not for less then 2 seconds.
Problem
I have a macro (I'll call it launch_macro) which is launched by double-clicking in an Userform ListBox (ListBox1_DblClick).
My problem is that if the user double-click again while the macro is still running, the macro will be launched again as soon as the first execution is finished, regardless of the fact that I'm disabling ListBox while the macro is running.
Code and tests
Private sub ListBox1_DblClick(Byval Cancel as MSForms.ReturnBoolean)
(....Logging...)
If Not Cancel Then
Me.ListBox1.Enabled = False
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
launch_macro
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
Me.ListBox1.Enabled = True
End If
End sub
It seems like Excel records/queues the ListBox1_DblClick events (for future execution) while the associated ListBox is disabled. Why that ? How can I prevent this ?
I also tried with no success :
Locked : Me.ListBox1.Locked = True
Doevents : Adding DoEvents after Me.ListBox1.Enabled = False
EnableEvents :Application.EnableEvents = False
macroLaunched variable :Using a variable to check if the macro is already launched (macroLaunched = True at the beginning of the ListBox1_DblClick event and macroLaunched = False at the end). This doesn't work since the second execution is launched after the end of the first event (thus the variable is set back toFalse). (And setting the variable back to False outside the scope of the Dbl_Click event is not acceptable since the user need to be able to launch the macro immediately again (but just not while the first execution is still running)).
Adding delay (for test purpose only) : I added a 10s delay (Application.Wait) right back after the launch_macro. I then double-clicked twice within 1s. The second execution still launched. I checked by logging : the 2nd ListBox1.Dbl_Click event is 'recorded' by Excel 12s after the first event.
Note : I'm using Office Standard 2013
Current 'solution'
This trick is adapted (to reduce delay) from A.S.H answer :
Private sub ListBox1_DblClick(Byval Cancel as MSForms.ReturnBoolean)
Static nextTime As Single
If Timer < nextTime then
Log_macro "Event canceled because Timer < nextTime : " & Timer
Exit Sub
End if
(....Logging...)
If Not Cancel Then
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
launch_macro
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
End If
nextTime = Timer + 0.5
Log_macro "nextTime = " & nextTime
End sub
It 'does the trick' but but I still don't like that ListBox1 is still enabled and Excel is still queueing events, thus I need to estimate how many time the user might Dbl_Click (depending on how long the macro takes) to estimate how much a delay I need (currently 0.5s to be able to handle (and log) at least 10 canceled events). Also, it seems like Excel doesn't really like (in regards to performance) queuing events while the macro is running.
Well I will post my suggestion, I hope you try it because may be it was misunderstood. The idea is that once the macro is finished, we set a delay of n seconds (say 2 seconds) before handling again the double-click event. This way, the dbl-clicks that were queued during the macro's execution are handled with no effect during these two seconds.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Static NextTime As Variant ' Will set a barrier for launching again the macro
If Not IsEmpty(NextTime) Then If Now < NextTime Then Exit Sub
ListBox1.Enabled = False
' Any event code
launch_macro
' ...
ListBox1.Enabled = True
NextTime = Now + TimeSerial(0, 0, 2) ' dbl-click events will have no effects during next 2 seconds
End Sub
You could use a variable to lock the critical section of code for a set amount of time.
The example below locks the critical part of Test() function in Sheet2 of an Excel workbook.
Option Explicit
Private booIsRunning As Boolean
Private Sub Test()
If Not booIsRunning Then
booIsRunning = True
Debug.Print "Hello."
Application.OnTime Now + TimeValue("00:00:02"), "Sheet2.UnlockTest"
End If
End Sub
Public Sub UnlockTest()
booIsRunning = False
End Sub
I am making my first Powerpoint 2007 macro and I am having a bit of trouble with it hanging, and not letting me move on to the next slide. I can press ESCAPE to quit the slideshow, but pressing space bar or anything else won't progress to the next slide. After a while, it just crashes. I come from a C++/Java background so I think its just something basic that I'm missing.
Basically I am trying to do a counter slide that counts the days/minutes/seconds from a particular date. When the slide loads I want it to show, in real time, how long its been since that date. I've put it through an infinite loop, which works fine to update the time, but then doesnt let me move on to the next slide.
Here's my code:
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
'If SSW.View.CurrentShowPosition = 3 Then
Do While SSW.View.CurrentShowPosition = 3 ' infinite loop
Dim currentSlide As Integer
currentSlide = SSW.View.CurrentShowPosition
Dim startDate As Date
Dim currentDate As Date
Dim sngDiff As Single
Dim lngDays As Long
Dim lngHours As Long
Dim lngMinutes As Long
Dim lngSeconds As Long
startDate = #7/22/2011 2:00:00 PM#
currentDate = Now
sngDiff = currentDate - startDate
lngDays = CLng(sngDiff)
sngDiff = sngDiff - lngDays
lngHours = Hour(sngDiff)
lngMinutes = Minute(sngDiff)
lngSeconds = Second(sngDiff)
With ActivePresentation.Slides(currentSlide)
With .Shapes(2)
.TextFrame.TextRange.Text = "It has been:" & lngDays & " Days " & lngHours & " hours " & lngMinutes & " minutes " & lngSeconds & " Seconds"
End With
End With
DoEvents
Loop
End Sub
Do I need to listen for some sort of button click to stop this infinite loop, or how do I do this?
Thanks.
A user form is something you add in the VBA editor; it's what you'd normally think of as a dialog box, though forms can be used for other things and needn't even become visible; that's what we're going to do here:
Option Explicit
Public bFormCodeRunning As Boolean
Sub FormDemo()
' Set a flag to let us know the code in the form
' is running
bFormCodeRunning = True
' "show" the form
UserForm1.Show vbModeless
End Sub
Sub KillForm()
' call this at some other point in the presentation
' when you're sure you're done running the form code
If Not bFormCodeRunning Then
Unload UserForm1
End If
' You could actually call this from your slide change event handler
End Sub
Then Insert, User Form from the menu to add a new form; doubleclick it to view its code and add this:
Private Sub UserForm_Activate()
' Don't show my face
Me.hide
DoEvents
' prove that the form's loaded
MsgBox "I'm well-formed"
DoEvents
' and put your other code here
' and when the code's done, flag it
bFormCodeRunning = False
End Sub
For doing a time delay in a VBA context it is usually better to use a form_timer object so in your code have:
If SSW.View.CurrentShowPosition = 3 Then
Me.TimerInterval = 1000
Else
Me.TimerInterval = 0
End If
Or something similar. Then in the form timer code have your clock update code
Private Sub Form_Timer()
// Your clock update code here
End Sub
It's been years since I've done any VBA so I'm a bit rusty but I hope this helps. In general use timers instead of loops for threading tasks, VBA doesn't cope well with them.
The problem is that your routine "owns" the app; until it exits, you won't be able to do anything manually (ie, advance to the next slide).
Whether or not you use a timer on a form (and fwiw, the Timer control isn't shipped with VBA as it is with VB), I think a form may be your solution.
Have your event handler load a form modelessly then exit.
The code in the form can then do any mods to slides or whatever else you want.
Include DoEvents often enough that you don't slow down the main app, but the code in the form will run independently of what the main app is doing.
You don't need to make the form visible (and probably don't want to).