StatusBar, ProgressBar a další možnosti zobrazení průběhu operace

Zatímco StatusBar je ovládací prvek představující stavový řádek, ProgressBar je narůstající sloupeček určený například pro zobrazení průběhu instalace. Microsoft je přitom na instalace expert. Nejprve doháněl uživatele k šílenství tím, že ProgressBar po dosažení 100 % začal opakovaně plnit zase od nuly, později tak, že z ProgressBaru udělal cosi jako policejní maják z amerických filmů, a dnes k tomu využívá textové žvásty (aktualizace se stahují, probíhá příprava na aktualizacích, procenta, nakonec vše je téměř dokončeno, a pak stejně ještě čekáte, až zahřmí).

Stavový řádek už v Excelu přeci jeden máme. Učebnicově je považován za nejlepší místo, kde zobrazit průběh delšího výpočtu, makra, atp. Základní ovládání ukazuje následující procedura.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

Sub StavovyRadekObecne()

'je zobrazen stavový řádek?
blnStavovyRadekZobrazen = Application.DisplayStatusBar

'zobrazení stavového řádku
Application.DisplayStatusBar = True

'zobrazení vlastního textu ve stavovém řádku
Application.StatusBar = "Probíhá výpočet..."

'nevhodný (nefunkční) reset stavového řádku
'Application.StatusBar = ""
'Application.StatusBar = vbNullString

'korektní reset stavového řádku
Application.StatusBar = False

End Sub

Excel - stavový řádek — Excel – stavový řádek

Pokud v cyklu VBA provádíme delší výpočty, je vhodné informovat o stavu detailněji.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

Sub StavovyRadekPrubeznyStav()

Dim i As Long
Dim lngPocet As Long

'počet cyklů
lngPocet = 10000

For i = 1 To lngPocet

'prostor pro zpracování systémových událostí
DoEvents

'změna textu ve stavovém řádku
Application.StatusBar = "Probíhá zpracování záznamu č. " & i & _
" z celkového počtu " & lngPocet & "."

Next i

'reset stavového řádku
Application.StatusBar = False

End Sub

Excel – průběh ve stavovém řádku

Je možné umístit informaci o průběhu jinam? Teoreticky je možné s využitím API přiřadit bublinu s textem do vlastní ikony v oznamovací části systémové lišty. Ta ale není určena k tomu, abyste do ní několikrát za sekundu „prali“ text. Takže co s tím? Co zkusit měnit text v titulku okna? Titulek v aplikaci Excel sestává při maximalizovaném okně sešitu ze dvou částí – z názvu sešitu a názvu aplikace (např. Sešit1.xlsm – Microsoft Excel).

Excel - titulky v oknech — Excel – titulky v oknech

Pojďme tedy informaci o stavu úlohy umístit do titulku.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

Sub TitulekAplikacePrubeznyStav()

Dim i As Long

For i = 1 To 1000

'prostor pro zpracování systémových událostí
DoEvents

'změna textu ve stavovém řádku
Application.Caption = "Probíhá zpracování záznamu č. " & i & _
" z celkového počtu 1000."

Next i

'reset stavového řádku
Application.Caption = vbNullString

End Sub

Excel - zobrazení průběhu v titulku okna aplikace — Excel – zobrazení průběhu v titulku okna aplikace

Zástupce sešitu na systémové liště přebírá titulek okna do svého popisku. Nesmíte ovšem mít nastavené seskupování zástupců (pravé tlačítko myši na liště a volba Vlastnosti).

Windows - seskupování zástupců na systémové liště — Windows – seskupování zástupců na systémové liště

Není mi úplně jasný princip, podle kterého je v zástupci stanoveno pořadí dvojice název aplikace – aktivní sešit. Jednou je to tak, podruhé opačně. Ve Windows 8.1 se mi také stává, že občas jedno z oken sešitů o svého zástupce v systémové liště přijde a popisek v něm pak neodpovídá situaci. A do třetice, zástupce běžně pojme maximálně 15-18 znaků z celého titulku (velikost je tuším možné měnit v registrech). Přes to všechno jsem se pustil do experimentu, kdy aplikaci minimalizuji (v průběhu běžícího makra nám stejně není k užitku) a změnu titulku okna (aplikace) promítám právě do jejího zástupce.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

Sub ZastupcePrubeznyStav()

Dim i As Long
Dim lngStavOknoSesit As Long
Dim lngStavOknoAplikace As Long

Dim wndOkno As Window

Set wndOkno = ActiveWindow

'uložení stavu okna sešitu
lngStavOknoSesit = wndOkno.WindowState

'maximalizace okna sešitu
wndOkno.WindowState = xlNormal

'uložení stavu okna aplikace
lngStavOknoAplikace = Application.WindowState

'minimalizace okna aplikace
Application.WindowState = xlMinimized

For i = 1 To 10000

'prostor pro zpracování systémových událostí
DoEvents

'změna titulku v okně sešitu (zástupci na liště)
Application.Caption = "č. " & i & " z 10000"

Next i

'reset titulku okna sešitu
wndOkno.Caption = False

'reset titulku okna aplikace
Application.Caption = vbNullString

'návrat k původnímu stavu okna sešitu
wndOkno.WindowState = lngStavOknoSesit

'návrat k původnímu stavu okna aplikace
Application.WindowState = lngStavOknoAplikace

End Sub

Excel – zobrazení průběhu v zástupci na liště

Vizuálně zajímavější možnost zobrazení průběhu představují právě ProgressBary. Nasimulujeme si první z nich ve stavovém řádku. Vystačíme si přitom s vhodným znakem Unicode sady.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

Sub StavovyRadekProgressBar1()

Dim intPocetZnakuMax As Integer
Dim intPocetZnaku As Integer

Dim i As Long
Dim lngPocetCyklu As Long

Dim sngProcento As Single

'maximální počet znaků ve stavovém řádku (100 %)
intPocetZnakuMax = 50

'počet cyklů (záznamů ke zpracování, výpočtů, ...)
lngPocetCyklu = 100000

For i = 1 To lngPocetCyklu

'prostor pro zpracování systémových událostí
DoEvents

'procento plnění
sngProcento = CInt((99 * i) / lngPocetCyklu)

'počet znaků odpovídajících procentu plnění
intPocetZnaku = CInt(intPocetZnakuMax * sngProcento / 99)

'změna textu ve stavovém řádku
If intPocetZnaku > 1 Then

'zobrazení procenta a symbolů kostičky
'nespojité kostičky ... &H25FC
Application.StatusBar = Format(sngProcento, "00") & " % " & _
String(intPocetZnaku, ChrW("&H2587"))

End If

Next i

'reset stavového řádku
Application.StatusBar = False

End Sub

Excel – simulovaný ProgressBar ve stavovém řádku

Historicky starší ProgressBary používali oddělené čtverečky. Zde je tedy ještě jeden způsob.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

Sub StavovyRadekProgressBar2()

Dim intPocetZnakuMax As Integer
Dim intPocetZnaku As Integer

Dim i As Long
Dim lngPocetCyklu As Long

Dim sngProcento As Single
Dim strProcento As String

'maximální počet znaků ve stavovém řádku (100 %)
intPocetZnakuMax = 50

'počet cyklů (záznamů ke zpracování, výpočtů, ...)
lngPocetCyklu = 100000

'třímezerová maska
strProcento = Space(3)

For i = 1 To lngPocetCyklu

'prostor pro zpracování systémových událostí
DoEvents

'procento plnění
sngProcento = CInt((100 * i) / lngPocetCyklu)

'dosazení procenta do masky (mezery zleva)
RSet strProcento = CStr(sngProcento)

'počet znaků odpovídajících procentu plnění
intPocetZnaku = CInt(intPocetZnakuMax * sngProcento / 100)

'změna textu ve stavovém řádku
If intPocetZnaku > 1 Then

'zobrazení procenta a symbolů kostiček
Application.StatusBar = strProcento & " % " & vbTab & _
String(intPocetZnaku, ChrW("&H25FC")) & String(intPocetZnakuMax - _
intPocetZnaku, ChrW("&H25FB"))

End If

Next i

'reset stavového řádku
Application.StatusBar = False

End Sub

Excel – simulovaný ProgressBar ve stavovém řádku

Dalším tipem budiž buňka s aplikovaným podmíněným formátem…

Excel - simulace ProgressBaru buňkou a podmíněným formátem — Excel – simulace ProgressBaru buňkou a podmíněným formátem

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

Sub BunkaProgressBar()

Dim i As Long
Dim lngPocetCyklu As Long

Dim sngProcento As Single

'počet cyklů (záznamů ke zpracování, výpočtů, ...)
lngPocetCyklu = 100000

For i = 1 To lngPocetCyklu

'prostor pro zpracování systémových událostí
DoEvents

'procento plnění
sngProcento = CInt((100 * i) / lngPocetCyklu)

If i Mod 1000 = 0 Then

Range("rngProgressBar").Value = sngProcento

End If

Next i

End Sub

Excel - ProgressBar v buňce v akci — Excel – ProgressBar v buňce v akci

Na internetu lze nalézt návody, jak vytvořit skutečný ProgressBar třeba na místě stavového řádku nebo v Řádku vzorců a to s pomocí API. Zde se tím zabývat nebudeme. I tak jsme si ukázali řadu vizuálních hraček. Nyní ovšem přijde pořádná herda do zad. Průběh stavu má smysl ukazovat tehdy, když je výpočet zdlouhavý (např. v cyklu zpracováváme tisíce záznamů). V takovém případě – jak jistě víte – používáme syntaxi Application.ScreenUpdating = False. Pokud ta ale bude plnit svou funkci, pak přeci k žádnému překreslování textu někde ve stavovém řádku dojít nemůže! Jenže ouha. I když ji v kódu aplikujeme, změnu ve stavovém řádku uvidíme (překreslování bude doprovázeno „flickeringem“, tj. problikáváním textu). Možná také víte, že v dlouhých cyklech je dobrých zvykem užít klauzuli DoEvents, kterou říkáme „dej taky prostor systému, ať si udělá to svoje“. Udělal jsem tedy řadu testů a nestačil se divit.

V tabulkách je zachycena průměrná doba běhu procedury v sekundách s různými obměnami podmínek (ScreenUpdating, DoEvents, bez výpisu, s výpisem do stavového řádku, titulku okna sešitu a titulku okna aplikace).

Excel - testy ScreenUpdating a DoEvents — Excel – testy ScreenUpdating a DoEvents

Poznatky
ScreenUpdating neumí částečné zmrazení okna, a proto, pokud zasahujeme do stavového řádku, zapíná se (časy jsou prakticky stejné). Jinak je jeho funkčnost srovnatelná s API funkcí LockWindowUpdate (velmi pravděpodobně ji na pozadí používá).
Příkaz DoEvents sice zpomalí průběh procedury, ale bez něj je jakýkoliv pokus o výpis bezpředmětný (překreslování velmi brzy zamrzne).
Překreslování titulku (nemaximalizovaného) okna sešitu doprovází vždy flickering. Stejně tak k němu pokaždé dochází v rámci stavového řádku při Application.ScreenUpdating = True.

Když se podíváte na čas bez všech serepetiček a srovnáte ho s ostatními, asi dojdete ke stejnému závěru, že jakákoliv nutnost překreslování vede k řádově jiným časům vykonání kódu (v příloze se můžete vyzkoušet). Znamená to, že máme na výpisy průběhu zapomenout? Ve smyslu výše uvedených technik ano. Asi nejschůdnější řešení vede mimo Excel – logování průběhu do textového souboru.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

Sub LogovaniPrubeznyStav()

Dim i As Long

Dim iFile As Integer
Dim strSoubor As String
Dim strObsah As String

'generované číslo
'pod kterým se později na soubor odkazujeme
iFile = FreeFile

'cesta a soubor
strSoubor = ThisWorkbook.Path & "\log.txt"

'otevření souboru pro přidávání záznamů na konec souboru
Open strSoubor For Append Access Write As iFile

For i = 1 To 10000

'prostor pro zpracování systémových událostí
DoEvents

'sestavení obsahu
strObsah = "Záznam č. " & i & " z 10000." & vbCrLf

'zápis do souboru
Print #iFile, strObsah;

Next i

'uzavření souboru
Close iFile

End Sub

Procedura v tomto případě zabrala cca 0,588 s. Do souboru je možné nahlížet i během jeho užívání programovým kódem.

Ovládací prvky StatusBar a ProgressBar na formuláři

Ve VBA nejsou tyto prvky běžně vidět. Je potřeba při návrhu formuláře klepnout pravým tlačítkem myši na Toolbox, zvolit Additional Controls a vybrat Microsoft StatusBar Control 6, resp. Microsoft ProgressBar Control 6. Následuje ukázka užití StatusBaru, ve kterém si zobrazíme aktuální datum a čas, text s informací o průběhu, a stav klávesy CAPS LOCK. A přirozeně nesmí chybět ani obyčejný Label, který svou úlohu splní také s přehledem.

Excel a VBA - prvek StatusBar — Excel a VBA – prvek StatusBar

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

'https://msdn.microsoft.com/en-us/library/aa733695(v=vs.60).aspx

Private Sub UserForm_Initialize()

With StatusBar1

'přidání čtyř sekcí do prvku StatusBar1
For i = 1 To 4
.Panels.Add
Next i

'datum
.Panels(1).Style = sbrDate
.Panels(1).Width = 50
.Panels(1).Bevel = sbrNoBevel

'čas
.Panels(2).Style = sbrTime
.Panels(2).Width = 25
.Panels(2).Bevel = sbrNoBevel

'příprava pro text
.Panels(3).Style = sbrText
.Panels(3).Alignment = sbrCenter
.Panels(3).Text = ""
.Panels(3).Width = 100
.Panels(3).Bevel = sbrNoBevel

'stav klávesy CAPS
.Panels(4).Style = sbrCaps
.Panels(4).AutoSize = sbrSpring
.Panels(4).Bevel = sbrNoBevel

End With

End Sub

Private Sub UserForm_Activate()

Dim i As Long
Dim lngPocetCyklu As Long

Dim strText As String

'počet cyklů (záznamů ke zpracování, výpočtů, ...)
lngPocetCyklu = 10000

For i = 1 To lngPocetCyklu

'text k zobrazení
strText = "Záznam č. " & i & " z " & lngPocetCyklu

'naplnění prvků
StatusBar1.Panels(3).Text = strText
Label1.Caption = strText

'překreslení formuláře
Me.Repaint

Next i

End Sub

Excel a VBA - prvek StatusBar v akci — Excel a VBA – prvek StatusBar v akci

Během prvních testů docházelo k flickeringu u obou prvků. Zatímco Labelu pomohlo navýšení hodnoty ve vlastnosti DrawBuffer formuláře z 32000 na 64000 až 128000, u StatusBaru jsem se jevu nezbavil. Z blíže neznámých příčin překreslování mělo tendenci i vytuhnout. StatusBar tedy není ideální prvek pro častou obměnu textu.

Pozn. Ve Windows 8.1 se mi nepodařilo v okně Properties využít položku Custom, kde bychom v dialogu nastavili vše, co je uvedeno v události Initialize formuláře výše.

Na druhém formuláři nasadíme do akce jak prvek ProgressBar, tak obyčejný prvek Label, u něhož nastavíme barvu pozadí, text skryjeme, a změníme programově pouze šířku.

Excel a VBA - prvek ProgressBar — Excel a VBA – prvek ProgressBar

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

Private intLabel2Sirka As Integer

Private Sub UserForm_Activate()

Dim i As Long
Dim lngPocetCyklu As Long

Dim sngProcento As Single

'počet cyklů (záznamů ke zpracování, výpočtů, ...)
lngPocetCyklu = 100000

For i = 1 To lngPocetCyklu

'prostor pro zpracování systémových událostí
DoEvents

'procento plnění
sngProcento = CInt((100 * i) / lngPocetCyklu)

'hodnota do popisku a prvku ProgressBar1
Label1.Caption = sngProcento & " %"
ProgressBar1.Value = sngProcento

'šířka prvku Label2
Label2.Width = sngProcento * intLabel2Sirka / 100

Next i

End Sub

Private Sub UserForm_Initialize()

'uložení šířky pro prvek Label2
intLabel2Sirka = Label2.Width

'nastvení nulové šířky
Label2.Width = 0

End Sub

Excel a VBA - prvek ProgressBar a Label v akci — Excel a VBA – prvek ProgressBar a Label v akci

Příloha:
excel-statusbar-progressbar.zip

Uložit článek jako PDF