2011年12月07日

長い時間を要する処理をしている間は、マウスカーソルを［砂時計］にしたり、進行の程度(現在どこまで進んでいるのかや、あとどれくらいかかるのか)を表示すると、ユーザに親切です。

そんな進行表示の方法を、三種類紹介します。

１．ステータスバー　その1

Excelにはそんな表示をするためのStatusBarというおApplication.StatusBar プロパティがあります。

Application.StatusBar プロパティの仕様は、VBAのヘルプをみてください。

以下、使用例です。  

Option Explicit

Dim oldstatusbar As Variant

Public abortFlag As Boolean

Public Sub setStatusBar(msg As Variant)

    'ステータスバー表示

    With Application

        oldstatusbar = .DisplayStatusBar

        .DisplayStatusBar = True

        .StatusBar = msg

    End With

End Sub

Public Sub msgStatusBar(msg As Variant)

    With Application

        .StatusBar = msg

    End With

End Sub

Public Sub resetStatusBar()

    'ステータスバー復帰

    With Application

        .StatusBar = False

        .DisplayStatusBar = oldstatusbar

    End With

End Sub

進行表示のテストプログラムです。

Public Sub progressbar11()

    'StatusBarで進行表示その1

    Dim idx As Long

    Const idxmax As Long = 20

    Dim tm As Variant

    'Excelウィンドウの左下にあるステータスバーを初期化する

    Call setStatusBar("しばらくお待ちください‥")

    For idx = 0 To idxmax

        'ステータスバーにメッセージを表示する

        Call msgStatusBar("しばらくお待ちください‥" & idx & "/" & idxmax)

        '**********

        '　本来の繰り返し処理がここに入る

        '**********

        '**********

        '　本来の繰り返し処理の代わり

        tm = Timer() 'システムのタイマー

        Do Until Timer() - tm > 1

            DoEvents '1 秒経過するまで待つ

        Loop

        '**********

    Next idx

    'ステータスバーをリセットする

    Call resetStatusBar

End Sub

２．ステータスバー　その2

今度は、同じステータスバーですが、少しグラフィカルっぼくしてみます。

Public Function initStrBar(barLength As Long) As Variant

    initStrBar = String(barLength, "□")

End Function

Public Function setStrBar(crntValue As Long, maxValue As Long, barLength As Long) As Variant

    setStrBar = String(CInt(barLength * crntValue / maxValue), "■") _

                & String(barLength - CInt(barLength * crntValue / maxValue), "□")

End Function

Public Sub progressbar12()

    'StatusBarで進行表示　その2

    Dim idx As Long

    Const idxmax As Long = 20

    Dim tm As Variant

    Const prgrsmax As Long = 30

    'Excelウィンドウの左下にあるステータスバーを初期化する

    Call setStatusBar(initStrBar(prgrsmax))

    For idx = 0 To idxmax

        'ステータスバーにバーを表示する

        Call msgStatusBar(setStrBar(idx, idxmax, prgrsmax))

        '**********

        '　本来の繰り返し処理がここに入る

        '**********

        '**********

        '　本来の繰り返し処理の代わり

        tm = Timer() 'システムのタイマー

        Do Until Timer() - tm > 1

            DoEvents '1 秒経過するまで待つ

        Loop

        '**********

    Next idx

    'ステータスバーをリセットする

    Call resetStatusBar

End Sub