home | get Sue’s code | forums | share code | registration

Outlook Technologies

Outlook Forms

Languages

Samples

More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 09-Feb-2010 02:48

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.

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
Body: 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 >> ]
	Anonymous 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.
	Anonymous 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?
	Willem 18-Dec-2005 06:27 Thank you. This is great. I had been looking for "Application.StatusBar" or something similar.
	Anonymous 27-Apr-2006 14:26 Perfect! Nice work.
	krog 20-Oct-2006 13:53 This is awesome! Thank you!
	John E. 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??
	Steve Bateman 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.
	Sue Mosher 20-Dec-2007 10:20 In VB6, a form is made modal by the calling statement, e.g. MyForm.Show vbModal
	John E. 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
	John E. 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 >> ]

name email

Search Outlook Code