More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 23-Apr-2014 11:00

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Login Password
Remember me
Register | Send my password
Code level: intermediate    Code area: Code Essentials Printer Friendly Version
Title: ProgressBox - VBA dialog/form showing progress
Description: Cross-application form for showing progress (with progress bar and descripptive text) from VBA. Can be used from Excel, Word, Outlook etc.
Date: 06-Oct-2005  23:30
Code level: intermediate
Code area: Code Essentials
Posted by: Steve Bateman
This message is displayed as VB.NET
 Option Explicit

' Implements a progress box with a progress bar and space for user-defined text above the bar
' Uses Microsoft's Forms library (by default available with all office/VBA installations)
' To use in your VBA project:
' 1) Make sure that the "Microsoft Forms" object library is checked in Tools/References
' 2) Insert a blank User Form
' 3) Rename the user form to "ProgressBox"
' 4) Set the user form property "showModal" to false (so you can do other things while the dialog is displayed)
' 5) Show the code for the User Form, and highlight/delete everything
' 6) Insert this file (using insert/file) into the code for the User Form
' 7) Add appropriate code to your VBA routine where you want to show progress:
'     * ProgressBox.Show --- shows the progress box. Include this before starting processing.
'     * ProgressBox.Increment newPercent (single), NewText (optional string) --- updates the progress bar and optionally changes the text
'     * ProgressBox.Hide --- removes the progress bar. Include this at the end of processing.
' 8) Optionally, you can get/set the percentage and the text individually using the "Percent" and "Text" properties, followed by calling ProgressBox.repaint

Private Const DefaultTitle = "Progress"
Private myText As String
Private myPercent As Single

' Text property shows user-defined text above the progress bar
Public Property Let Text(newText As String)
  If newText <> myText Then
    myText = newText
    Me.Controls("UserText").Caption = myText
    Call sizeToFit
  End If
End Property

Public Property Get Text() As String
  Text = myText
End Property

' Percent property alters the progress bar
Public Property Let Percent(newPercent As Single)
  If newPercent <> myPercent Then
    ' limit percent to between 0 and 100
    myPercent = Min(Max(newPercent, 0#), 100#)
    Call updateProgress
  End If
End Property

Public Property Get Percent() As Single
  Percent = myPercent
End Property

' Increment method enables the percent and optionally the text to be updated at same time
Public Sub Increment(ByVal newPercent As Single, Optional ByVal newText As String)
  Me.Percent = newPercent
  If newText <> "" Then Me.Text = newText
  Call updateTitle
  Me.Repaint
End Sub

' Setup the progress dialog - title, control layout/size etc.
Private Sub UserForm_Initialize()
  Call setupControls
  Call updateTitle
End Sub

' Prevents use of the Close button
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

' Removes any current controls, add the needed controls ...
Private Sub setupControls()
  Dim i As Integer
  Dim aControl As Label
  ' remove existing controls
  For i = Me.Controls.Count To 1 Step -1
    Me.Controls(i).Remove
  Next i
  ' add user text - don't worry about positioning as "sizeToFit" takes care of this
  Set aControl = Me.Controls.Add("Forms.Label.1", "UserText", True)
  aControl.Caption = ""
  aControl.AutoSize = True
  aControl.WordWrap = True
  aControl.Font.Size = 8
  ' add progressFrame - don't worry about positioning as "sizeToFit" takes care of this
  Set aControl = Me.Controls.Add("Forms.Label.1", "ProgressFrame", True)
  aControl.Caption = ""
  aControl.Height = 16
  aControl.SpecialEffect = fmSpecialEffectSunken
  ' add user text - don't worry about positioning as "sizeToFit" takes care of this
  Set aControl = Me.Controls.Add("Forms.Label.1", "ProgressBar", True)
  aControl.Caption = ""
  aControl.Height = 14
  aControl.BackStyle = fmBackStyleOpaque
  aControl.BackColor = &HFF0000 ' Blue
  ' position the controls and size the progressBox
  Call sizeToFit
End Sub


' Adjusts positioning of controls/size of form depending on size of user text
Private Sub sizeToFit()
  ' setup width of progress box
  Me.Width = 240
  ' user-supplied text should be topmost, taking up the appropriate size ...
  Me.Controls("UserText").Top = 6
  Me.Controls("UserText").Left = 6
  Me.Controls("UserText").AutoSize = False
  Me.Controls("UserText").Font.Size = 8
  Me.Controls("UserText").Width = Me.InsideWidth - 12
  Me.Controls("UserText").AutoSize = True
  ' progress frame/bar should be below user text
  Me.Controls("ProgressFrame").Top = Int(Me.Controls("UserText").Top + Me.Controls("UserText").Height) + 6
  Me.Controls("ProgressFrame").Left = 6
  Me.Controls("ProgressFrame").Width = Me.InsideWidth - 12
  Me.Controls("ProgressBar").Top = Me.Controls("ProgressFrame").Top + 1
  Me.Controls("ProgressBar").Left = Me.Controls("ProgressFrame").Left + 1
  Call updateProgress ' update ProgressBar width
  ' finally, height of progress box should fit around text and progress bar & allow for title/box frame
  Me.Height = Me.Controls("ProgressFrame").Top + Me.Controls("ProgressFrame").Height + 6 + (Me.Height - Me.InsideHeight)
End Sub

' updates the caption of the progress box to keep track of progress
Private Sub updateTitle()
  If (Int(myPercent) Mod 5) = 0 Then
    Me.Caption = DefaultTitle & " - " & Format(Int(myPercent), "0") & "% Complete"
  End If
End Sub

' updates the width of the progress bar to match the current percentage
Private Sub updateProgress()
  If myPercent = 0 Then
    Me.Controls("ProgressBar").Visible = False
  Else
    Me.Controls("ProgressBar").Visible = True
    Me.Controls("ProgressBar").Width = Int((Me.Controls("ProgressFrame").Width - 2) * myPercent / 100)
  End If
End Sub

' Min and Max functions
Private Function Min(number1 As Single, number2 As Single) As Single
  If number1 < number2 Then
    Min = number1
  Else
    Min = number2
  End If
End Function

Private Function Max(number1 As Single, number2 As Single) As Single
  If number1 > number2 Then
    Max = number1
  Else
    Max = number2
  End If
End Function
All 21comments
Page [ 1 2 3 Next >>  
  18-Oct-2005  17:48   
This is exactly what I need but it wont work. It won't "show" the ProgressBox.. I get a "Type mismatch". I'm new to this but can't get it to work.
  19-Oct-2005  09:00   
Can you post the code you're using to show the progress box? And maybe a little information on which of the office apps you're using, and where in the object model for the office app you've put the code that should show the progress box?

One other thought - for this to work the name "ProgressBox" needs to be unique within the app/office document - is it?
  18-Dec-2005  06:27   
Thank you. This is great. I had been looking for "Application.StatusBar" or something similar.
  27-Apr-2006  14:26   
Perfect! Nice work.
  20-Oct-2006  13:53   
This is awesome! Thank you!
  17-Dec-2007  17:33   
I am using VB6 and don't see a property for the new form titled showModal so I can set it to False. How do I set my form's property for showModal = False??
  19-Dec-2007  03:46   
It may be that this property is specific to VBA, and doesn't exist in VB6. Try it without setting the property.
  20-Dec-2007  10:20   
In VB6, a form is made modal by the calling statement, e.g.

    MyForm.Show vbModal
  19-Jan-2008  18:37   
When I attempt to start this ProgressBox from my main procedure using 'ProgressBox.Show vbModal', it displays the ProgressBox form OK, but doens't show any progress bar control in the form. Then when I click X to close the ProgressBox form, it gives me this error:

Run time error 730: Control'Progress Bar' not found.

This error in debugger points to the 'Me.Controls' statements in this sub in your ProgressBox form code. Any ideas how to fix this?

' updates the width of the progress bar to match the current percentage
Private Sub updateProgress()
  If myPercent = 0 Then
    Me.Controls("ProgressBar").Visible = False
  Else
    Me.Controls("ProgressBar").Visible = True
    Me.Controls("ProgressBar").Width = Int((Me.Controls("ProgressFrame").Width - 2) * myPercent / 100)
  End If
End Sub
 
  19-Jan-2008  18:53   
Sue, don't you mean ProgressBox.Refresh rather than ProgressBox.Repaint where used in the code? I find no method for .Repaint in VB6.
Page [ 1 2 3 Next >>