プログレス・バーを表示
ループなど時間のかかる処理を行っていると、画面表示が固まったままとなるために心配になります。ちゃんと動いているのか、それともフリーズしてしまったのか、一見してわからないためです。
そこで、たとえば秒針つきの時計とか、画像の点滅とか、なにか動くものを表示しておきたくなります。
一般的なのは、いわゆるプログレス・バーですね。
プログレス・バーは、出来合いで用意されているコントロールを使う方法や、ステータスバー上に表示する方法などがよく紹介されていますが、いずれも一長一短があるとか、64ビットではなんだか使えたり使えなかったりするらしいとか、カスタマイズの自由度がちょっととか・・・と思って、自作してみました。ワークシートの所定の場所に所定の長さで表示するプログレス・バーです。
手順そのものは、最初に外枠の四角をShapeで描き、その中のバーを表すShapeをステップに応じた長さで表示する、という簡単なものですが、けっこう威力を発揮します。
そのコードはこんな感じです。
使い方は、こうなるかな
Public Sub ProgressBarDemo()
Dim n
ShowBar 100 '初期設定（最大値を設定）
For n = 1 To 100
'--- 本体の作業 ---
StepForward n 'バーの表示
Next
End Sub
標準モジュール ShowBar()、StepForward()、DeleteBar()
Private pbUnitSize 'ステップ当たりのバーの長さ
'------- スタート
Public Sub ShowBar(maxCount)
'--- 既存のバーがあったら消去しておく
DeleteBar
pbUnitSize = 600 / maxCount
'--- まず外枠を描いて
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
20, 20, 600, 20)
.Name = "frame"
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
'--- バー本体を長さ０で用意しておく
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
20, 20, 0, 20)
.Name = "bar"
.Fill.PresetTextured msoTextureDenim
End With
End Sub
'------- バーの表示
Public Sub StepForward(count)
Dim pw
'--- バーを count に応じた長さにする
pw = count * pbUnitSize
ActiveSheet.Shapes("bar").width = pw
DoEvents
End Sub
'------- バーの消去
Public Sub DeleteBar()
On Error Resume Next
With ActiveSheet
.Shapes("frame").Delete
.Shapes("bar").Delete
End With
Err.clear
End Sub
もう少しきちんと書いたのが、次のクラスです。こういうクラスに収めてやって部品として用意しておくと、中身をすべて忘れてしまっても臨機応変に汎用に使うことができます。
クラスモジュール ProgressBarClass
'----- カウント表示を付加する場合の文字の大きさ
Public IndicatorFontSize '途中で変更可能
'----- 作業用の定数
Private Const frameNamePrefix = "pbFrame-" '枠名の前置詞
Private Const barNamePostFix = "-bar" 'バー名の後置詞
Private Const frameMargin = 3
Private Const defaultFontSize = 8
Private Const defaultTexture = msoTextureDenim
'----- 作業用の変数
Private frameName '枠名
Private barName 'バー名
Private pbSheet '表示するワークシート
Private indicatorRange '表示するセル範囲
Private pbDataCount, pbUnitSize '以下、バーの位置、大きさなど
Private pbHeight, pbWidth, pbTop, pbLeft
Private pbTexture
Private pbCounterSW 'カウント数を表示するかどうか
Private Property Let maxCount(maxC) '最大カウント数の設定
If maxC <= 0 Then Exit Property
pbDataCount = maxC
pbUnitSize = pbWidth / pbDataCount
End Property
'----- 初期値の設定
Public Sub Init( _
frameNum, _ 'このバーの固有番号
showRange, _ 'このバーを表示するセルの範囲
Optional texture = defaultTexture _ 'バーのテクスチュア
)
frameName = frameNamePrefix & frameNum
barName = frameName & barNamePostFix
With showRange
If showRange.Cells(1).Column <= 1 Then Stop
pbWidth = .width - frameMargin * 2
pbHeight = .height - frameMargin * 2
pbTop = .top + frameMargin
pbLeft = .left + frameMargin
Set indicatorRange = .Cells(1).Offset(0, -1) '表示範囲の左隣はカウント表示用に確保
Set pbSheet = showRange.Worksheet
End With
IndicatorFontSize = defaultFontSize
pbTexture = texture
End Sub
'------- スタートして待機
Public Sub Show( _
maxC, _ '最大カウント数
Optional indicatorSW = False _ 'カウント数を表示するかどうか
)
maxCount = maxC
If pbDataCount = 0 Then Exit Sub
Delete
With pbSheet.Shapes.AddShape(msoShapeRectangle, _
pbLeft, pbTop, pbWidth, pbHeight)
.Name = frameName
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
With pbSheet.Shapes.AddShape(msoShapeRectangle, _
pbLeft, pbTop, 0, pbHeight)
.Name = barName
.Fill.PresetTextured pbTexture
End With
indicatorRange.Font.Size = IndicatorFontSize
pbCounterSW = indicatorSW
StepForward 0
End Sub
'------- ステップごとのバーの表示
Public Sub StepForward(count)
Dim pw
pw = count * pbUnitSize
If pw > pbWidth Then pw = pbWidth
pbSheet.Shapes(barName).width = pw
If pbCounterSW Then indicatorRange.Value = count
DoEvents
End Sub
'------- この枠とバーの消去
Public Sub Delete()
On Error Resume Next
With pbSheet
.Shapes(frameName).Delete
.Shapes(barName).Delete
End With
If pbCounterSW Then indicatorRange.Value = ""
Err.clear
End Sub
この使い方は、以下のように簡単です。
試しにアクティブなワークシートのセル範囲("B4:F4")の中にバーを表示します。
標準モジュール ProgressBarDemo()
Public Sub ProgressBarDemo()
Dim pBar1, n
Set pBar1 = New ProgressBarClass
pBar1.Init 1, ActiveSheet.Range("B4:F4")
pBar1.Show 100
For n = 1 To 100
'----- 本体の作業 ---
pBar1.StepForward n
Next
End Sub
ちょっと長いですが、こういうクラスを用意しておけば、たとえば一枚のワークシート上に複数の独立したプログレス・バーを設置して、別々に進行状況を表示する、ということもできます。
このクラスのインスタンスを複数作って、それぞれ別々の初期化をしておけばいいだけのことですから。
バーのテクスチュアは、ここではデフォルトとしてデニム(msoTextureDenim)を使っていますが、msoTexture… でいろいろなものが用意されていますので、ググってみてください。
下は、それぞれテクスチュアの異なるバーを５つ生成して、同時に動かしたものです。
