The Previous page showed the code for the UserForm.
The code for the main program is below.
The two private variables go at the very top of the code module.
Private NewfrmProgress As frmProgress
Private NewLabel1 As msforms.Label
Sub MainProgram()
Dim i As Integer
Dim intProcess1ReturnValue, _
intProcess2ReturnValue As Integer
Dim intMainProgramProcess1ArgValue, _
intMainProgramProcess2ArgValue As Long
Dim objStartTime, objEndTime As Variant
'Create a new instance of frmProgress.
Set NewfrmProgress = New frmProgress
'Create a new instance of the Label Control.
Set NewLabel1 = NewfrmProgress.frameProgress. _
Controls.Add(bstrProgId:="forms.label.1", _
Name:="NewLabel1", Visible:=True)
'Set some properties of new label.
NewLabel1.BackColor = &HFF&
NewfrmProgress.frameProgress.NewLabel1.Width = 0
NewfrmProgress.frameProgress.NewLabel1.Left = 0
NewfrmProgress.frameProgress.NewLabel1.Height = 10
NewfrmProgress.frameProgress.NewLabel1.Top = 4
'Set some variables for testing purposes.
intMainProgramProcess1ArgValue = 250000
intMainProgramProcess2ArgValue = 500000
'Get systen time at start of process1.
objStartTime = Timer
'Set caption of UserForm.
NewfrmProgress.Caption = _
"Progress Meter - Process 1"
'Run Process1
ProcessWithProgressMeter _
"Process1", intMainProgramProcess1ArgValue
'Get the return value of process 1from the UserForm.
intProcess1ReturnValue = NewfrmProgress.intResults
'Get system time at end of process1.
objEndTime = Timer
'Display the results of process 1 in a message box.
MsgBox "Process 1 time: " & _
Format((objEndTime - objStartTime), "###.#") & _
" seconds" & vbCrLf & "Process 1 Return Value: " & _
intProcess1ReturnValue
'Get systen time at start of process2.
objStartTime = Timer
'Reset the caption for Process 2.
NewfrmProgress.Caption = "Progress Meter - Process 2"
'Run Process 2
intAnything = ProcessWithProgressMeter("Process2", _
intMainProgramProcess2ArgValue)
'Get the return value of process 2 from the Userform.
intProcess2ReturnValue = NewfrmProgress.intResults
'Get systen time at start of process2.
objEndTime = Timer
'Display the results of process 2 in a message box.
MsgBox "Process 2 time: " & _
Format((objEndTime - objStartTime), "###.#") & _
" seconds" & vbCrLf & "Process 2 Return Value: " & _
intProcess2ReturnValue
End Sub
Note that Process 1 is initiated with the command:
ProcessWithProgressMeter _ "Process1", intMainProgramProcess1ArgValue
Process2 is initiated with the command:
intAnything = ProcessWithProgressMeter("Process2", _
intMainProgramProcess2ArgValue)
The first one cannot have parentheses around the arguments.
The second one must have parentheses around the arguments.
Function ProcessWithProgressMeter(ByVal strProcName As _ String, yVal intReceivedValue1) As Long 'Pass 2 parameters to the userform 'by setting the userform properties. NewfrmProgress.ProcValue = intReceivedValue1 NewfrmProgress.ProcName = strProcName 'Show the userform NewfrmProgress.Show 'Hide the userform. NewfrmProgress.Hide 'Prepare the return value for the MainProgram. ProcessWithProgressMeter = _ NewfrmProgress.intResults EEnd Function
The command line above with NewfrmProgress.Show will next lead to the following UserForm event.
Private Sub UserForm_Activate()
Me.Width = 240
Me.Height = 60
Me.frameProgress.Height = 20
Me.frameProgress.Width = 225
Me.frameProgress.Top = 12
Me.frameProgress.Left = 5
Select Case UCase(strProcName)
Case "PROCESS1"
intResultsValue = Process1(intProcValue)
Me.intResults = intResultsValue
Case "PROCESS2"
intResultsValue = Process2(intProcValue)
Me.intResults = intResultsValue
End Select
End Sub One of the parameters received by the erForm is strProcName.
It is used by the UserForm in the Select Case statement to control which processed the UserForm will run.
The second parameter received by the UserForm is intProcValue.
It is the value that needs to be passed to the function being called next.
Those two functions shown below. The functions do not do anything useful. The first one will loop to 250,000 and the second one will loop to 500,000. Your actual program functions would be placed in these functions.
Function Process1(ByVal intLastNumber As Long)
'intLastNumber will be 250000
'from the MainProgram above.
Dim pctdone As Single
Dim i As Long
Dim intProcess1ReturnValue As Long
Dim ProgressCounter As Long
ProgressCounterEnd = intLastNumber
'Loop through all files.
'Simple steps intended to take up
'some processor time.
For i = 1 To intLastNumber
ProgressCounter = i
'Only update the ProgressMeter
'once every 10 times.
If i Mod 10 = 0 Then
pctdone = ProgressCounter / ProgressCounterEnd
UpdateProgressBar pctdone
End If
Next i
'Make up a return value.
Process1 = 100
NewfrmProgress.Hide
End Function
Process2:
Function Process2(ByVal intLastNumber As Long)
'intLastNumber will be 500000
'from the MainProgram above.
Dim pctdone As Single
Dim i As Long
Dim Process2ReturnValue As Integer
Dim ProgressCounter As Long
ProgressCounterEnd = intLastNumber
'Loop through all files.
'Simple steps intended to take up
'some processor time.
For i = 1 To intLastNumber
ProgressCounter = i
'Only update the ProgressMeter
'once every 10 times.
If i Mod 10 = 0 Then
pctdone = ProgressCounter / ProgressCounterEnd
UpdateProgressBar pctdone
End If
Next i
'Make up a return value.
Process2 = 200
NewfrmProgress.Hide
End Function The last function is shown below. This is the one that will update the progress meter.
Sub UpdateProgressBar(pctdone As Single)
With NewfrmProgress
' Update the Caption property of the
'Frame control by showing new percentage number
.frameProgress.Caption = Format(pctdone, "0 %")
' Widen the Label control.
.frameProgress.NewLabel1.Width = pctdone * _
(.frameProgress.Width)
End With
'The DoEvents causes the UserForm to update.
DoEvents
End Sub After you start the inProgram at the top of this page, the ProgressMeter shown below will appear.
This progress meter is updated 25,000 times while the program runs.
This is one of the 25,000 updates captured after about 3 seconds.
ThThe code in Process1 and Process2 said.
If i Mod 10 = 0 Then pctdone = ProgressCounter / ProgressCounterEnd UpdateProgressBar pctdone End If
This caused it to update erytime that i was evenly divisibly by 10 while i went from 1 to 250,000 in process1.
After Process1 finished the MessageBox from MainProgram below was displayed.
This means that the red label control width went from 0 to the full width of the frame in about 6.5 seconds. It will look like a continuous movement.
The frame title showing 50% complete is also updated 25,000 times and it will change from 1% to 100% in about 6 seconds.
It will be almost impossible to read the Percentage Complete since it is moving so fast. The ProgressMeter will also be a bit jerky.
In a real world application I would change if i mod 10 to if i mod 20. This would cause the ProgressMeter to update whenever i is evenly divisible by 20. In the example above it would update 12,500 times and appear less jerky and the Percentage Complete will be easier to read.
After you click on OK on the messagebox Process2 will start.
After about 3 seconds the ProgressMeter will look like the following:
After Process2 finished the MessageBox below will appear.
Process2 counted to 500,000. It updated the ProgressMeter 50,000 times during the process. The Percentage Complete was a bit easier to read since it went from 1% to 100% in about 12 seconds in Process2 compared to 6.5 seconds in Process1.
I would still update if i mod 10 to if i mod 20. so that t would only update 25,000 times.
From there I would experiment with different values of mod and check the appearance of the ProgressMeter each time until it looks least jerky.
