Sub wasteTime()
Dim i As Long
Dim diag As New ProgressDialogue
diag.Configure "Wasting Time", "Now wasting your time...", -10000, 10000
diag.Show
For i = -10000 To 10000
diag.SetValue i
diag.SetStatus "Now wasting your time... " & i
If diag.cancelIsPressed Then Exit For
Next i
diag.Hide
End Sub
Option Explicit
Dim Cancelled As Boolean, showTime As Boolean, showTimeLeft As Boolean
Dim startTime As Long
Dim BarMin As Long, BarMax As Long, BarVal As Long
Private Declare Function GetTickCount Lib "Kernel32" () As Long
'Title will be the title of the dialogue.
'Status will be the label above the progress bar, and can be changed with SetStatus.
'Min is the progress bar minimum value, only set by calling configure.
'Max is the progress bar maximum value, only set by calling configure.
'CancelButtonText is the caption of the cancel button. If set to vbNullString, it is hidden.
'optShowTimeElapsed controls whether the progress bar computes and displays the time elapsed.
'optShowTimeRemaining controls whether the progress bar estimates and displays the time remaining.
'calling Configure sets the current value equal to Min.
'calling Configure resets the current run time.
Public Sub Configure(ByVal title As String, ByVal status As String, _
ByVal Min As Long, ByVal Max As Long, _
Optional ByVal CancelButtonText As String = "Cancel", _
Optional ByVal optShowTimeElapsed As Boolean = True, _
Optional ByVal optShowTimeRemaining As Boolean = True)
Me.Caption = title
lblStatus.Caption = status
BarMin = Min
BarMax = Max
BarVal = Min
CancelButton.Visible = Not CancelButtonText = vbNullString
CancelButton.Caption = CancelButtonText
startTime = GetTickCount
showTime = optShowTimeElapsed
showTimeLeft = optShowTimeRemaining
lblRunTime.Caption = ""
lblRemainingTime.Caption = ""
Cancelled = False
End Sub
'Set the label text above the status bar
Public Sub SetStatus(ByVal status As String)
lblStatus.Caption = status
DoEvents
End Sub
'Set the value of the status bar, a long which is snapped to a value between Min and Max
Public Sub SetValue(ByVal value As Long)
If value < BarMin Then value = BarMin
If value > BarMax Then value = BarMax
Dim progress As Double, runTime As Long
BarVal = value
progress = (BarVal - BarMin) / (BarMax - BarMin)
ProgressBar.Width = 292 * progress
lblPercent = Int(progress * 10000) / 100 & "%"
runTime = GetRunTime()
If showTime Then lblRunTime.Caption = "Time Elapsed: " & GetRunTimeString(runTime, True)
If showTimeLeft And progress > 0 Then _
lblRemainingTime.Caption = "Est. Time Left: " & GetRunTimeString(runTime * (1 - progress) / progress, False)
DoEvents
End Sub
'Get the time (in milliseconds) since the progress bar "Configure" routine was last called
Public Function GetRunTime() As Long
GetRunTime = GetTickCount - startTime
End Function
'Get the time (in hours, minutes, seconds) since "Configure" was last called
Public Function GetFormattedRunTime() As String
GetFormattedRunTime = GetRunTimeString(GetTickCount - startTime)
End Function
'Formats a time in milliseconds as hours, minutes, seconds.milliseconds
'Milliseconds are excluded if showMsecs is set to false
Private Function GetRunTimeString(ByVal runTime As Long, Optional ByVal showMsecs As Boolean = True) As String
Dim msecs&, hrs&, mins&, secs#
msecs = runTime
hrs = Int(msecs / 3600000)
mins = Int(msecs / 60000) - 60 * hrs
secs = msecs / 1000 - 60 * (mins + 60 * hrs)
GetRunTimeString = IIf(hrs > 0, hrs & " hours ", "") _
& IIf(mins > 0, mins & " minutes ", "") _
& IIf(secs > 0, IIf(showMsecs, secs, Int(secs + 0.5)) & " seconds", "")
End Function
'Returns the current value of the progress bar
Public Function GetValue() As Long
GetValue = BarVal
End Function
'Returns whether or not the cancel button has been pressed.
'The ProgressDialogue must be polled regularily to detect whether cancel was pressed.
Public Function cancelIsPressed() As Boolean
cancelIsPressed = Cancelled
End Function
'Recalls that cancel was pressed so that they calling routine can be notified next time it asks.
Private Sub CancelButton_Click()
Cancelled = True
lblStatus.Caption = "Cancelled By User. Please Wait."
End Sub
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (10)
Commented:
1st GREAT WORK! I've played with your progress bar within your sample workbook but is there a way you could assist me with the following code below. I'm not an expert with VBA (still have my training wheels on).
I have a code that opens another workbook, copies data from the newly opened workbook and pastes it into the original workbook, then exports the data into Access for storage.
Open in new window
My question is would I update the "progress bar" code to work with the vba shown above.
I downloaded the example workbook, read through your article and for an expert it explains it well but I'm sort of lost because of my inexperience with loops and setting MIN and MAX values for iterations. ((O_O))
Thank you in advance! :)
Author
Commented:Your question is quite specific to your own situation and won't contribute to future readers, so what you should do is post a new question and reference this article and someone will assist you in exchange for points.
Commented:
Commented:
Commented:
1 comment, 1 question.
Comment: instead of exporting and importing modules/forms you can simply drag and drop them from one workbook to the other.
Question on your procedure 'wasteTime'. You declare "Dim diag As New ProgressDialogue" but I get a compile error on this: "user-defined type not defined." Is there a reference I need to add?
View More