【VBA】ステータスバーで進捗状況をアニメーションする

エクセルVBAで使うコードの備忘録。エクセルのステータスバーで進捗状況を確認するために簡単なアニメーション表示をしてみましょう。長時間の処理を待っている時間がちょっとだけ楽しくなるかもしれません。

スポンサーリンク

ステータスバーって？

ステータスバーはエクセルの画面左下にある小さな領域のことです。エクセルで作業をしているとこの部分に処理の内容などが表示されることがあります。詳しくはこちらの記事をご覧ください。

ステータスバー

ステータスバーでアニメーション表示

ステータスバーで処理状況を表示するだけでも、ユーザーにとっては進捗状況を把握できるためありがたいのですが、同じメッセージが長時間変わらずに表示されたままであると、本当に処理が進んでいるのか不安になってきます。表示されているメッセージを少しでも変化させること（アニメーション）でユーザーのこのような不安を解消することが可能です。ただ、アニメーションといってもとても複雑なものはできません。が、例えば「計算中…」の…を処理に合わせて増減させたりとか、表示する文字をうまくコントロールすることによってちゃんと処理が行われていることをユーザーに伝えることは可能です。

以下では、私が思いつく限りでメッセージを変化させる例をご紹介します。何かよいものを思いついたらその都度追記していきます。

i番目を処理中（i/n)

シンプルなものの一つは、n個の中のi番目の処理が行われているというメッセージをステータスバーに表示するものです。このようにすることで、残りの処理がいくつ残っていてどれくらい済んだのかをユーザが把握できるので待ち時間のストレスが軽減されます。

i番目を処理中（i/n)

Public Sub StatusBarAnimation1()
    
    Application.ScreenUpdating = True
    
    '--- ループ回数 ---'
    Dim n As Long
    n = 1000
    
    '--- ステータスバーの表示 ---'
    Dim i As Long
    For i = 1 To n
        
        Application.StatusBar = i & "番目を処理中（" & n & "個中）"
    
    Next i
    
    '--- 表示が不要になったらメッセージを消去 ---'
    Application.StatusBar = False
      
End Sub

計算中…

次は、「計算中…」という表示の「…」部分を増減させるものです。下記のサンプルではループ100回ごとに「.」が一つ増えるようにしてあります。「.」が増える間隔を変えたい場合はmの値を調整してください。

計算中…

Public Sub StatusBarAnimation2()
    
    Application.ScreenUpdating = True
    
    '--- ループ回数 ---'
    Dim n As Long
    n = 1000
    
    '--- ステータスバーの表示 ---'
    Dim i As Long
    Dim j As Long
    Dim m As Long
    Dim strTmp As String
    For i = 1 To n
        
        '--- ループ回数に応じて...の数を調整（mごと） ---'
        m = 100
        strTmp = ""
        For j = 0 To (Application.WorksheetFunction.RoundDown((i / m), 0) Mod 4)
            strTmp = strTmp & "."
        Next j
        
        Application.StatusBar = "計算中" & strTmp
    
    Next i
    
    '--- 表示が不要になったらメッセージを消去 ---'
    Application.StatusBar = False
      
End Sub

プログレスバー（■■□□□□）

次は、疑似的なプログレスバーを表示する方法です。中抜きの四角（□）が進捗状況に応じて徐々に塗りつぶされた四角（■）になっていきます。

■■□□□□□□□□（???％完了）

Public Sub StatusBarAnimation3()
    
    Application.ScreenUpdating = True
    
    '--- ループ回数 ---'
    Dim n As Long
    n = 10000
    
    '--- ステータスバーの表示 ---'
    Dim i As Long
    Dim j As Long
    Dim m As Long
    Dim completePct As Double
    Dim strTmp As String
    For i = 1 To n
        
        '--- ループ回数に応じて■□の数を調整 ---'
        completePct = i / n
        strTmp = ""
        m = Application.WorksheetFunction.RoundDown(completePct * 10, 0)
        For j = 1 To m
            strTmp = strTmp & "■"
        Next j
        For j = 1 To (10 - m)
            strTmp = strTmp & "□"
        Next j
        
        Application.StatusBar = strTmp & "（" & Format(completePct * 100, "#") & "％完了）"
    
    Next i
    
    '--- 表示が不要になったらメッセージを消去 ---'
    Application.StatusBar = False
      
End Sub
スポンサーリンク