Progress Bar
If your macro takes a long time to execute and you’d like to make the user feel warm and fuzzy about the macro’s progress, a progress bar is just what you need. VBA provides the StatusBar propery of the Application object that you can use to indicate progress. It’s what Excel usually uses for that purpose.
The StatusBar property takes text and you can pass any text you want to it, to display to the user. Setting this property to False returns control of the status bar back to Excel, so don’t forget to set it to False when you’re done.
Here’s an example that uses the status bar to show squares that indicate the progress of the macro. It shows a maximum of 10 squares as defined by the constant. The squares are produced using ASCII character 31. Like I said before, you can use any text you want, including tacking on the percentage in numbers to the end of you text. This simple example lacks the visual indication of how far along the macro is, it just shows that it’s progressing. You can use two different characters in the status bar and have them change to show progress.
The Wait method is used in this example to simulate a macro that takes a long time to execute.
Sub ShowProgress()
Dim i As Long
Dim dPctDone As Double
Dim lSqrNum As Long
Const lMAXSQR As Long = 10
For i = 1 To 30
dPctDone = i / 30
lSqrNum = dPctDone * lMAXSQR
Application.StatusBar = Application.Rept(Chr(31), lSqrNum)
Application.Wait Now + TimeSerial(0, 0, 1)
Next i
Application.StatusBar = False
End Sub
The StatusBar property provides a simple way to show progress. If you’d like something a little snazzier, try these sites:
JWalk’s Progress Bar
van Gelder’s Progress Bar
Stephen Bullen’s Progress Bar
The hardest part of using a progress indicator is including the code that really indicates how far the macro is. I have a macro that refreshes a bunch of QueryTables. If all the QueryTables were the same size, the progress bar would be useful. As it is, it stays on 4% for a long time, then jumps to 97%. And just so you don’t think you’re the only one with a to-do list, it finishes at 102%. I’ve really been meaning to fix that.
If you have links to other nice progress bars, or some cool tricks of your own, leave a comment.
Andy Pope:
I have a few variations on the simple progress bar.
22 June 2004, 4:55 pmhttp://www.andypope.info/vba/pmeter.htm
Nick:
The best progress bars I’ve found are the one’s that use APIs. The macro runs much faster than having a progress bar using up excel memory by updating a form or worksheet.
Just my 2c worth.
22 June 2004, 5:37 pmJamie Collins:
“The best progress bars I’ve found are the one’s that use APIs”
Yes, the code posted recently and attributed to Michel Pierron is particularly appealing and worth repeating here:
‘ < --- Excel UI version--->
Option Explicit
Private Declare Function FindWindow& _
Lib “user32″ Alias “FindWindowA” _
(ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function CreateWindowEX& _
Lib “user32″ Alias “CreateWindowExA” _
(ByVal dwExStyle&, ByVal lpClassName$, _
ByVal lpWindowName$, ByVal dwStyle&, _
ByVal x&, ByVal y&, ByVal nWidth&, _
ByVal nHeight&, ByVal hWndParent&, _
ByVal hMenu&, ByVal hInstance&, _
lpParam As Any)
Private Declare Function DestroyWindow& _
Lib “user32″ (ByVal hwnd&)
Private Declare Function SendMessage& _
Lib “user32″ Alias “SendMessageA” _
(ByVal hwnd&, ByVal wMsg&, ByVal wParam&, _
lParam As Any)
Private Declare Function GetClientRect& _
Lib “user32″ (ByVal hwnd&, lpRect As RECT)
Private Declare Function FindWindowEx& _
Lib “user32″ Alias “FindWindowExA” _
(ByVal hWnd1&, ByVal hWnd2&, ByVal lpsz1$, _
ByVal lpsz2$)
Private Type RECT
cl As Long
ct As Long
cr As Long
cb As Long
End Type
Sub PBarDraw(ByVal MaxProgress As Long)
Dim BarState As Boolean
Dim hwnd&, pbhWnd&, y&, h&, i&, R As RECT
hwnd = FindWindow(vbNullString, Application.Caption)
hwnd = FindWindowEx(hwnd, ByVal 0&, “EXCEL4″, vbNullString)
GetClientRect hwnd, R
h = (R.cb - R.ct) - 6: y = R.ct + 3
pbhWnd = CreateWindowEX(0, “msctls_progress32″, “” _
, &H50000000, 35, y, 185, h, hwnd, 0&, 0&, 0&)
SendMessage pbhWnd, &H409, 0, ByVal RGB(0, 0, 125)
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
For i = 1 To MaxProgress
DoEvents
Application.StatusBar = Format(i / MaxProgress, “0%”)
SendMessage pbhWnd, &H402, Val(Application.StatusBar), 0
Next i
DestroyWindow pbhWnd
Application.StatusBar = False
Application.DisplayStatusBar = BarState
End Sub
‘
‘ < --- UserForm version--->
Option Explicit
Private Declare Function FindWindow& _
Lib “user32″ Alias “FindWindowA” _
(ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function CreateWindowEX& _
Lib “user32″ Alias “CreateWindowExA” _
(ByVal dwExStyle&, ByVal lpClassName$, _
ByVal lpWindowName$, ByVal dwStyle&, _
ByVal x&, ByVal y&, ByVal nWidth&, _
ByVal nHeight&, ByVal hWndParent&, _
ByVal hMenu&, ByVal hInstance&, _
lpParam As Any)
Private Declare Function DestroyWindow& _
Lib “user32″ (ByVal hwnd&)
Private Declare Function SendMessage& _
Lib “user32″ Alias “SendMessageA” _
(ByVal hwnd&, ByVal wMsg&, ByVal wParam&, _
lParam As Any)
Private Sub CommandButton1_Click()
Me.CommandButton1.Enabled = False
Me.Repaint
Dim y&, W&, mehWnd&, pbhWnd&, i&
mehWnd = FindWindow(vbNullString, Me.Caption)
W = Me.InsideWidth * 4 / 3
y = (Me.InsideHeight - 15) * 4 / 3
pbhWnd = CreateWindowEX(0, “msctls_progress32″, “” _
, &H50000000, 0, y, W, 20, mehWnd, 0&, 0, 0&)
SendMessage pbhWnd, &H409, 0, ByVal RGB(0, 125, 0)
For i = 1 To 50000
DoEvents
SendMessage pbhWnd, &H402, CInt(100 * i / 50000), 0
Next i
DestroyWindow pbhWnd
Me.CommandButton1.Enabled = True
End Sub
‘
Jamie.
–
23 June 2004, 5:00 amJuan Pablo:
The file ‘Control the LED Display in the StatusBar’ found here is great too:
http://j-walk.com/ss/excel/files/developer.htm
23 June 2004, 9:11 amAndy Miller:
I kinda like the use of the status bar for a progress bar.
Here’s a method that is a bit more visually appealing though:
7 July 2004, 3:13 pmFlores:
Hi all, i would like to use a progress bar (like excel) in my site (Flores).
Anyone knows how to implement this progress bar in asp? Thanka a lot.
Mario Flores
25 January 2005, 6:46 ammarian:
hi, how can i use progress bar to indicate state of saving workbook? (sorry for my bad english). thanx.
22 March 2006, 12:47 pmCLJones:
anybody know how to find out the length of time the progress bar is going to take? I want to include it in a macro that freezes the screen whilst it’s calulating. Suggestd please!
29 August 2006, 3:27 amJon Peltier:
In general there’s really no way to know how long your process will take. Don’t think of the “time” it will take, think of the % complete of the task. You can make approximations, so if a procedure loops eight times, after each loop you advance the short bar another 1/8 of the longth of the long bar. I’ve noticed that the newer style is to have the small bar move back and forth, and the user has no way of knowing how many trips it will take. I would think you should avoid that and make at least a wild guess about the duration of the task.
30 August 2006, 5:42 amWade:
Updated the code above that Jamie Collins posted. Copy the code below into a module and use as per the test() sub.
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function CreateWindowEX& Lib "user32" Alias "CreateWindowExA" _
(ByVal dwExStyle&, ByVal lpClassName$, _
ByVal lpWindowName$, ByVal dwStyle&, _
ByVal x&, ByVal y&, ByVal nWidth&, _
ByVal nHeight&, ByVal hWndParent&, _
ByVal hMenu&, ByVal hInstance&, _
lpParam As Any)
Private Declare Function DestroyWindow& Lib "user32" (ByVal hwnd&)
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)
Private Declare Function GetClientRect& Lib "user32" (ByVal hwnd&, lpRect As RECT)
Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1&, ByVal hWnd2&, ByVal lpsz1$, _
ByVal lpsz2$)
Private Type RECT
cl As Long
ct As Long
cr As Long
cb As Long
End Type
Dim pbhWnd&
Dim nMaxProgress As Integer
Dim bBarState As Boolean
Sub initBar(ByVal nMax As Integer)
Dim hwnd&, y&, h&, i&, R As RECT
nMaxProgress = nMax
hwnd = FindWindow(vbNullString, Application.Caption)
hwnd = FindWindowEx(hwnd, ByVal 0&, "EXCEL4", vbNullString)
GetClientRect hwnd, R
h = (R.cb - R.ct) - 6: y = R.ct + 3
pbhWnd = CreateWindowEX(0, "msctls_progress32", """" _
, &H50000000, 35, y, 185, h, hwnd, 0&, 0&, 0&)
SendMessage pbhWnd, &H409, 0, ByVal RGB(0, 0, 125)
bBarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
End Sub
Sub updateBar(nCount As Integer)
Application.StatusBar = Format(nCount / nMaxProgress, "0%")
SendMessage pbhWnd, &H402, Val(Application.StatusBar), 0
End Sub
Sub clearBar()
DestroyWindow pbhWnd
Application.StatusBar = False
Application.DisplayStatusBar = bBarState
End Sub
Sub test()
Dim x As Integer
On Error GoTo cleanUp
initBar (5)
' before you start your processing, set up the bar with the number
' of steps/records/worksheets/whatever
For x = 1 To 5
updateBar (x) 'increment the count every time you finish working on something
MsgBox x & " of 5 steps complete" 'do *something* - in this case a msgbox so we can see the bar working
Next x
cleanUp:
clearBar 'clean up the bar when you're done - put this in your error handling section to make sure the bar is cleaned up properly
End Sub
Mauro:
hello everybody, talking about status bars: I like my sheets to be funny too. When people wait for something to happen I show them funny sentences (some in italian, some in english). Here is the code I use:
Dim DelayBetweenText
Dim TextSample
Dim NumberOfTexts
Public TimeStart
Sub INI()
DelayBetweenText = 10 'seconds
NumberOfTexts = 50
ReDim TextSample(NumberOfTexts)
TextSample(1) = "Niente é facile come sembra"
TextSample(2) = "Tutto richiede più tempo di quanto si pensi"
TextSample(3) = "Lasciate a se stesse, le cose tendono a andare di male in peggio"
TextSample(4) = "Tutto va male nello stesso tempo"
TextSample(5) = "Sorridi... Domani sarà peggio"
TextSample(6) = "Madre natura é una stronza"
TextSample(7) = "Ogni soluzione genera nuovi problemi"
TextSample(8) = "Le cose vengono danneggiate in proporzione al loro valore"
TextSample(9) = "Quando non può andar peggio di così, lo farà"
TextSample(10) = "If the enemy is in range, so are you"
TextSample(11) = "Qualsiasi cosa vada male, avrà probabilmente l'aria di andare benissimo"
TextSample(12) = "Quando si trova e si corregge un errore, si vedrà che andava meglio prima"
TextSample(13) = "Se un esperimento funziona, qualcosa é andato male"
TextSample(14) = "Prima tracciate le curve che vi servono, poi trovate i punti che corrispondono"
TextSample(15) = "Non credete ai miracoli: contateci ciecamente"
TextSample(16) = "Non c'é mai tempo di fare bene le cose, ma c'é sempre tempo per rifarle"
TextSample(17) = "Quando vedi la luce in fondo al tunnel, il soffitto crolla"
TextSample(18) = "Niente é impossibile per colui che non deve farlo da solo"
TextSample(19) = "Lo sporco costituisce il 90 per cento di tutto"
TextSample(20) = "Funziona meglio se si mette la spina"
TextSample(21) = "Non funzionerà"
TextSample(22) = "Quando lavori alla soluzione di un problema, sapere la risposta aiuta sempre"
TextSample(23) = "Chi non può permettersi di pagare l'affitto é in affitto. Chi può permettersi di pagare l'affitto é proprietario"
TextSample(24) = "La strada più facile é sempre minata"
TextSample(25) = "Ogni filo metallico tagliato su misura sarà troppo corto"
TextSample(26) = "L'unica maniera per ritrovare un oggetto smarrito é comprarne uno nuovo"
TextSample(27) = "Se il tuo attacco funziona, sei caduto in un'imboscata"
TextSample(28) = "Never draw fire, it irritates everyone around you"
TextSample(29) = "Anything you do can get you shot, including nothing"
TextSample(30) = "Make it tough enough for the enemy to get in and you won't be able to get out"
TextSample(31) = "Never share a foxhole with anyone braver than yourself"
TextSample(32) = "Se il proprio treno é in ritardo, la coincidenza partirà in perfetto orario"
TextSample(33) = "Never forget that your weapon is made by the lowest bidder"
TextSample(34) = "Ogni errore di calcolo sarà nella direzione del massimo danno"
TextSample(35) = "If at first you don't succeed call in an air-strike"
TextSample(36) = "Smile, it makes people wonder what you are thinking"
TextSample(37) = "Se si perde un numero di una qualsiasi rivista, sarà il numero che conteneva l 'articolo che si era tanto ansiosi di leggere"
TextSample(38) = "Thou shalt not commit adultery.....unless in the mood"
TextSample(39) = "One good turn gets most of the blankets"
TextSample(40) = "Sex discriminates against the shy and the ugly"
End Sub
Sub Auto_open()
15 January 2008, 5:24 pmINI
'starts the text for the first time
No = Int((NumberOfTexts * Rnd) + 1) ' Random between 1 and NumberOfTexts
'schow text in bar
Application.StatusBar = TextSample(No)
'calculate the time for the next text change
If DelayBetweenText
Lars:
Created in Excel 2003:
' Module: mProgressBar
' Version: 2008-07-25
' Author: Lars Uffmann, lars.uffmann@dlr.de
' Purpose: provide an easy to use progress bar for MS Excel
' License: BSD
' * Copyright (c) 2008, Lars Uffmann, Cologne, Germany
' * All rights reserved.
' *
' * Redistribution and use in source and binary forms, with or without
' * modification, are permitted provided that the following conditions are met:
' * * Redistributions of source code must retain the above copyright
' * notice, this list of conditions and the following disclaimer.
' * * Redistributions in binary form must reproduce the above copyright
' * notice, this list of conditions and the following disclaimer in the
' * documentation and/or other materials provided with the distribution.
' * * Neither the name of the nor the
' * names of its contributors may be used to endorse or promote products
' * derived from this software without specific prior written permission.
' *
' * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ''AS IS'' AND ANY
' * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
' * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
' * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
' * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
' * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
' * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
' * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
' * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
' * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
'
' Example Usage:
' initializeProgress
' showProgress "My Progress Indicator", "Please stand by while data is being processed..."
' ' do something
' updateProgress 30#
' ' do something
' updateProgress 80#
' ' do something
' updateProgress 100# ' this only makes sense if you give the user some time to
' ' admire the complete progress bar before closing the form
' closeProgress
Option Explicit
Private existsFrmProgress As Boolean ' has the form already been created?
Private hRootFrmProgress As Object ' handle for object creation, ShowModal property and later removal
Private hOuterFrmProgress As Object ' handle for "outer" form properties & methods, e.g. size, position, show()
Private frmProgress As UserForm ' handle for UserForm properties access
Private Const pbAUTOSIZE As Long = -1 ' for better readability
' this is the default value for optional size and position parameters
Private Const pbAVG_CHAR_WIDTH As Long = 5 ' used to autosize the form width
Private Const pbMARGIN_LEFT As Long = 15 ' left margin
Private Const pbMARGIN_RIGHT As Long = 15 ' right margin
Private Const pbMARGIN_TOP As Long = 10 ' top margin
Private Const pbMARGIN_BOTTOM As Long = 10 ' bottom margin: ignored if the progress bar gets too small
Private Const pbSYSMENU_HEIGHT As Long = 21 ' actual height 20.75 but I don't wanna bother with Doubles here
Private Const pbLABEL_HEIGHT As Long = 18 ' used to autosize the form height
Private Const pbBEST_BAR_HEIGHT As Long = 20 ' used to autosize the form height
Private Const pbMIN_BAR_HEIGHT As Long = 5 ' used to autosize the progress bar
Private Const pbDEF_MIN_VALUE As Double = 0# ' default minimum for progress bar value range
Private Const pbDEF_MAX_VALUE As Double = 100# ' default maximum for "
' Procedure: initializeProgress
' Purpose: reset the module-global variables
' Example Usage: initializeProgress
Public Sub initializeProgress()
Set hRootFrmProgress = Nothing
Set hOuterFrmProgress = Nothing
Set frmProgress = Nothing
existsFrmProgress = False
End Sub
' Procedure: showProgress
' Purpose: create a UserForm, add a text and a progress bar, size everything and display it
' Example Usage: showProgress
Public Sub showProgress(Optional title As String = "Progress Bar", _
Optional message As String = "Please stand by while the operation is being processed...", _
Optional wWidth As Long = pbAUTOSIZE, Optional wHeight As Long = pbAUTOSIZE, _
Optional wLeft As Long = pbAUTOSIZE, Optional wTop As Long = pbAUTOSIZE, _
Optional minValue As Double = pbDEF_MIN_VALUE, Optional maxValue As Double = pbDEF_MAX_VALUE)
Dim curTop As Long
If (existsFrmProgress) Then
MsgBox "form already there!"
Exit Sub
End If
existsFrmProgress = True
' For this next operation to work, you need to have "Trust Access to visual basic project" checked
' in the macro security (Tools -> Options -> Security -> Macro Security)
Set hRootFrmProgress = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_MSForm)
' do not display modal, otherwise code execution will be stopped until window is closed by the user
hRootFrmProgress.Properties("ShowModal") = False
' use of Name property omitted because VBA bugs out here if a previously used name is reused (same session)
' hRootFrmProgress.Properties("Name") = "UserForm_Progress"
Set hOuterFrmProgress = VBA.UserForms.Add(hRootFrmProgress.Name) ' get outer form handle
Set frmProgress = hOuterFrmProgress ' typecast to UserForm handle
' determine autosizes as required
If wWidth = pbAUTOSIZE Then wWidth = pbMARGIN_LEFT + Len(message) * pbAVG_CHAR_WIDTH + pbMARGIN_RIGHT
If wHeight = pbAUTOSIZE Then wHeight = pbMARGIN_TOP + pbSYSMENU_HEIGHT + pbLABEL_HEIGHT + pbBEST_BAR_HEIGHT + pbMARGIN_BOTTOM
' initialize form
With hOuterFrmProgress
.Caption = title
.width = wWidth
.height = wHeight
End With
' initalize vertical position for next control
curTop = pbMARGIN_TOP
' create & initialize label for message text
frmProgress.Controls.Add "Forms.Label.1", "lblMessage", True
With frmProgress("lblMessage")
.Caption = message
.left = pbMARGIN_LEFT
.top = curTop
.width = frmProgress.InsideWidth - pbMARGIN_LEFT - pbMARGIN_RIGHT
' re-initalize vertical position for next control
curTop = curTop + .height
End With
' create & initialize progress bar
frmProgress.Controls.Add "MSComctlLib.ProgCtrl.2", "prgProcessing", True
With frmProgress("prgProcessing")
.left = pbMARGIN_LEFT
.top = curTop
.width = frmProgress.InsideWidth - pbMARGIN_LEFT - pbMARGIN_RIGHT
If (frmProgress.InsideHeight - curTop - pbMARGIN_BOTTOM) > pbMIN_BAR_HEIGHT Then
.height = frmProgress.InsideHeight - curTop - pbMARGIN_BOTTOM
Else
.height = pbMIN_BAR_HEIGHT
End If
' work around the *extremely annoying* behaviour of the progress bar value range
If minValue .max Then .max = maxValue
.Value = minValue
.min = minValue
.max = maxValue
' re-initalize vertical position for next control
curTop = curTop + .height
End With
' display form centered (.Show does this)
hOuterFrmProgress.Show
' re-position form if required
If (wLeft pbAUTOSIZE) Then hOuterFrmProgress.left = wLeft
If (wTop pbAUTOSIZE) Then hOuterFrmProgress.top = wTop
' force full (initial) painting of form
frmProgress.Repaint
End Sub
' Procedure: updateProgress
' Purpose: show some progress
' Example Usage: updateProgress 50#
Public Sub updateProgress(progress As Double)
If Not existsFrmProgress Then
Exit Sub
End If
' update progress bar value & force repaint of form
frmProgress("prgProcessing").Value = progress
frmProgress.Repaint
End Sub
' Procedure: closeProgress
' Purpose: close & delete the UserForm
' Example Usage: closeProgress
Public Sub closeProgress()
If Not existsFrmProgress Then
MsgBox "form not there, can't close!"
Exit Sub
End If
' close form
Unload hOuterFrmProgress
' delete form
Application.VBE.ActiveVBProject.VBComponents.Remove hRootFrmProgress
' reset global variables
25 July 2008, 12:19 pminitializeProgress
End Sub
Lars:
btw I did provide proper indentation - too bad that doesn't work with html *g*
25 July 2008, 12:20 pmVl3ui:
Require: dotnet 3.5 install -->http://download.microsoft.com/download/6/0/f/60fc5854-3cb8-4892-b6db-bd4f42510f28/dotnetfx35.exe (I'm not sure it is required or not, because my PC had .NET 2008 installed. You can go thru 1,2 if it's not there then you need to install dotnet3.5)
1. In VBA windows, click Tools ->References -> check System_Windows_Form
2. Right click ToolBar(make sure form is selected)->Additional Controls -> Check Microsoft ProgressBar 6.0, now in your toolbar will have new icon calls progressbar
3. Put it in to a form or make a new form for it.
4. Code:
ProgressBar1.visible = true/False (turn it on or of)
ProgressBar1.Value = 0 - Max (you can set max in its properties)
How to use it is up to you, put it in the loop or put the ProgressBar1.value = XX after each command.
Good Luck and spread the words for all nubies programmers like me.
3 September 2008, 11:23 am