2011年12月07日
長い時間を要する処理をしている間は、マウスカーソルを[砂時計]にしたり、進行の程度(現在どこまで進んでいるのかや、あとどれくらいかかるのか)を表示すると、ユーザに親切です。
そんな進行表示の方法を、三種類紹介します。
1.ステータスバー その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.ステータスバー その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
実行結果は次のとおり。
少しはグラフィカルになったでしようか?
まだまだですかね??
実行結果は以下のとおりです。