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.

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.

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

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.

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.

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ě

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.

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

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

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

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

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

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.

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

'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

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