Mendip Data Systems
Database applications for businesses and schools
Option Compare Database
Option Explicit
Dim intMaxLength As Integer
Dim sngIncrement As Single
Global N As Long, iCount As Long
Global frm As Access.Form
'##############################
'module to manage progress bars for multiple forms
'##############################
Public Sub SetupProgressBar()
On Error GoTo ErrHandler
'##############################
'Updated to manage multiple forms
'##############################
On Error GoTo ErrHandler
If Screen.ActiveForm.Name = "frmStart" Then Set frm = Forms!frmStart
'add other forms that use the progress bar code
'If Screen.ActiveForm.Name = "MainMenu" Then Set frm = Forms!MainMenu
'If Screen.ActiveForm.Name = "AdminMenu" Then Set frm = Forms!AdminMenu
N = 0
If iCount = 0 Then iCount = 50 'default value if not set on host form
'CR modified v5261 to fix issue where progress bar stayed at 0% when reused
'replaced boxProgressTop.Width (which varies) with BoxProgressBottom.Width (fixed)
intMaxLength = frm.boxProgressBottom.Width 'CR modified v5261
sngIncrement = frm.boxProgressBottom.Width / iCount 'CR modified v5261
frm.boxProgressTop.Width = 0
frm.lblProgressCaption.Caption = "0%"
frm.boxProgressBottom.Visible = True
frm.boxProgressTop.Visible = True
frm.lblProgressCaption.Visible = True
If Screen.ActiveForm.Name = "frmRelinkTables" Then
frm.lblProgressCaption.ForeColor = vbWhite
Else
frm.lblProgressCaption.ForeColor = vbBlack
End If
frm.Repaint
DoEvents
ExitHandler:
Exit Sub
ErrHandler:
'err 2475 = none of the forms listed are active
If Err = 2475 Then
Exit Sub
Else
MsgBox "Error " & Err.Number & " in SetupProgressBar procedure : " & Err.Description
Resume ExitHandler
End If
End Sub
Public Sub UpdateProgressBar()
'############################################
' Updated to manage multiple forms
' fore color changed at 65% - was 50%
'############################################
On Error GoTo ErrHandler
If Screen.ActiveForm.Name = "frmStart" Then Set frm = Forms!frmStart
'add other forms that use the progress bar code
'If Screen.ActiveForm.Name = "MainMenu" Then Set frm = Forms!MainMenu
'If Screen.ActiveForm.Name = "AdminMenu" Then Set frm = Forms!AdminMenu
'update progress bar
N = N + 1
If frm.boxProgressTop.Width < intMaxLength Then
DoEvents 'needed to let computer continue with other tasks
frm.boxProgressTop.Width = (frm.boxProgressTop.Width + sngIncrement)
frm.lblProgressCaption.Caption = Int(100 * (frm.boxProgressTop.Width / intMaxLength)) & "%"
If frm.boxProgressTop.Width / intMaxLength > 0.65 Then
If Screen.ActiveForm.Name = "frmSelectReview" Then
frm.lblProgressCaption.ForeColor = vbBlack 'CR v5301
Else
frm.lblProgressCaption.ForeColor = vbYellow
End If
ElseIf Screen.ActiveForm.Name = "frmRelinkTables" Then
frm.lblProgressCaption.ForeColor = vbWhite
Else
frm.lblProgressCaption.ForeColor = vbBlack
End If
End If
frm.Repaint
DoEvents
ExitHandler:
Exit Sub
ErrHandler:
'err 2475 = none of the forms listed are active
If Err = 2475 Then
Exit Sub
Else
MsgBox "Error " & Err.Number & " in UpdateProgressBar procedure : " & Err.Description
Resume ExitHandler
End If
End Sub
Public Sub HideProgressBar()
'##############################
'Updated to manage multiple forms
'##############################
On Error GoTo ErrHandler
If Screen.ActiveForm.Name = "frmStart" Then Set frm = Forms!frmStart
'add other forms that use the progress bar code
'If Screen.ActiveForm.Name = "MainMenu" Then Set frm = Forms!MainMenu
'If Screen.ActiveForm.Name = "AdminMenu" Then Set frm = Forms!AdminMenu
'Hide progress bar
frm.boxProgressBottom.Visible = False
frm.boxProgressTop.Visible = False
frm.lblProgressCaption.Visible = False
iCount = 0
N = 0
ExitHandler:
Exit Sub
ErrHandler:
'err 2475 = none of the forms listed are active
If Err = 2475 Then
Exit Sub
Else
MsgBox "Error " & Err.Number & " in HideProgressBar procedure : " & Err.Description
Resume ExitHandler
End If
End Sub
Code Samples for Businesses, Schools & Personal Use
The attached example databases show one method of adding a progress bar to a form
There are 2 versions:
1. using a solid bar (in this case coloured magenta)
2. using a suitable image (in this case using colours from a flag)
Normally the bar would be used to indicate the progress of a lengthy procedure containing many separate steps e.g. SQL statements or queries or a repeated code loop
For the purposes of the example databases, a form timer event is used to show progress
There are 3 functions used with the progress bar
1. SetupProgressBar - used at the start of the procedure to display the bar and start the process
2. UpdateProgressBar - used after each step in the procedure
3. HideProgressBar - used at the end of the procedure - hide the bar and reset the counter
To use this in your own applications:
a) Copy the module modProgress and enter the form name(s) in each function
b) Add the progress bar control and (optionally) the textbox used to indicate progress
c) determine the total number of steps to be monitored by the progress bar and enter this in the
form just before the SetUpProgressBar code line
NOTE:
Adding a progress bar helps database users know roughly how long a task will take to complete
However, adding this will slightly increase the time needed to do so!
The code works in both 32-bit and 64-bit Access
Code:
Progress Bar
Screenshots
Click any image to view a larger version ...
Return to Code Samples Page