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