Code Samples for Businesses, Schools & Developers

Screenshots

Click any image to view a larger version

Fig 1 - Solid bar

ProgressBar1

Fig 2 - Image (flag colours)

ProgressBar2

Fig 3 - Image (gradient fill)

ProgressBar3

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

Return to Code Samples Page Return to Top