Mendip Data Systems

Database applications for businesses and schools

LogoTransparent

 

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

Updated 25/03/2018              

 

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 to download:

 

 Example Progress Bar     Example Progress Bar With Image        Approx 0.5 MB  (zipped)

Click any image to view a larger version ...

ProgressBar1 ProgressBar2 Return to Code Samples Page