Last Updated 3 Dec 2020
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. See Fig 1
2. using a suitable image - in this case using colours from a flag. See Fig 2
NOTE: a gradient fill can easily be used as the image. See Fig 3
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
However, for the purposes of the example databases, a form timer event is used to show progress
There are three 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 to hide the progress 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, doing this will also slightly increase the time needed to do so!
The code works in both 32-bit and 64-bit Access
CODE:
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()
'----------------------------------------------------
'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
intMaxLength = frm.boxProgressBottom.Width
sngIncrement = frm.boxProgressBottom.Width / iCount
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 changes 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
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
Click to download:
Example Progress Bar Example Progress Bar With Image Approx 0.5 MB (zipped)
Colin Riddington Mendip Data Systems Last Updated 3 Dec 2020
