Progress Bar

[isladogs]

Attached is an updated version of my progress bar app.

The example app contains 4 forms with different variations of the progress bar:
1. using a solid bar with progress based on a series of events (update queries).

2. using a solid bar with progress done using a timer event.

3. using an image - in this case using colours from a flag. See Fig 3

4. using an image - in this case using a gradient fill. See Fig 4

The code is all in module modProgress:

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(frm As Form)

On Error GoTo ErrHandler

N = 0 'reset step count
If iCount = 0 Then iCount = 50 'default value for number of steps 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
frm.lblProgressCaption.ForeColor = vbBlack
frm.Repaint
DoEvents

ExitHandler:
    Exit Sub

ErrHandler:   
  'err 2475 = the form listed isn't active; err 2467 = object closed
    If Err = 2475 Or err=2467 Then
        Exit Sub
    Else
        MsgBox "Error " & Err.Number & " in SetupProgressBar procedure : " & Err.Description
        Resume ExitHandler
    End If


End Sub

'================================

Public Sub UpdateProgressBar(frm As Form)

'############################################
' fore color changed at 55% 
'############################################

On Error GoTo ErrHandler

'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.55 Then frm.lblProgressCaption.ForeColor = vbYellow
End If

frm.Repaint
DoEvents

ExitHandler:
    Exit Sub

ErrHandler:
     'err 2475 = the form listed isn't active; err 2467 = object closed
    If Err = 2475 Or err=2467 Then
        Exit Sub
    Else
        MsgBox "Error " & Err.Number & " in UpdateProgressBar procedure : " & Err.Description
        Resume ExitHandler
    End If

End Sub

'================================

Public Sub HideProgressBar(frm As Form)

On Error GoTo ErrHandler

'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 = the form listed isn't active; err 2467 = object closed
    If Err = 2475 Or err=2467 Then
        Exit Sub
    Else
        MsgBox "Error " & Err.Number & " in HideProgressBar procedure : " & Err.Description
        Resume ExitHandler
    End If
      
End Sub

Typical usage:

Private Sub cmdStart_Click()

If Me.cmdStart.Caption = "Start" Then
      Me.cmdStart.Caption = "Stop"

     'enter number of steps to be run e.g. 5

      iCount = 5
      SetupProgressBar Me

      'step 1 - run some code here e.g. update query & update progress bar
      CurrentDb.Execute "UPDATE . . . ", dbFailOnError
      UpdateProgressBar Me
      DoEvents     'pause to allow screen to update

      'step 2 - run some more code here e.g. append query & update progress bar
      CurrentDb.Execute "INSERT . . . ", dbFailOnError
      UpdateProgressBar Me
      DoEvents

      'step 3 - run some more code here e.g. update query & update progress bar
      CurrentDb.Execute "UPDATE . . . ", dbFailOnError
      UpdateProgressBar Me
      DoEvents

      'step 4 - run some more code here e.g. append query & update progress bar
      CurrentDb.Execute "INSERT . . . ", dbFailOnError
      UpdateProgressBar Me
      DoEvents

      'step 5 - run some more code here e.g. delete query & update progress bar
      CurrentDb.Execute "DELETE . . . ", dbFailOnError
      UpdateProgressBar Me
      DoEvents

      'pause briefly to show completed
      Me.LblHelpText.Caption = "Updates completed . . . "
      DoEvents

      'reset form
      Me.cmdStart.Caption = "Start"

      'hide progress bar and help text
      HideProgressBar Me
      Me.LblHelpText.Visible = False

Else
      'reset form if process stopped by user
      Me.cmdStart.Caption = "Start"
      HideProgressBar Me
      Me.LblHelpText.Visible = False

End If

End Sub

For more details, see my website article:

Progress Bar

This is a simple but effective progress bar for use in Access forms. Several different versions are provided based on a timer or a series of events. The progress bar can use a solid bar, image or gradient fill.

www.isladogs.co.uk

 

[strive4peace]

thanks, Colin @isladogs -- great examples too ... very creative! Good teaching and fantastic food for thought

 

[Miki13]

Thanks, very useful!

 

[Garcimat]

thank you

 

[jocph]

Just what I am looking for! Thank you!

 

[isladogs]

Just what I am looking for! Thank you!

@Miki13 , @Garcimat , @jocph
You are all very welcome. Hope you find it useful