VBAにて作業進捗度を可視化するプログレスバーを自作します。ツール>参照設定からプログレスバーの用意はされているかと思いますが、バージョンによって使えなかったりなど不便かと思いますので、面倒なことは抜きに簡易的に自作しました。
ちなみにですが手抜きです。参考までにしていただき、お好みで改変などしていただければと思います。
1.フォームで進捗バーの画面を作成
今回はこんな感じのプログレスバーの画面を作成しました。非常にシンプルです。
フォーム名は"Ufrm01_ProgressForm"にしました。
用意したオブジェクトはたったの3つで、「処理中...」の表示と、バーと、パーセント表示する3つのLabelオブジェクトだけです。
今回こちらで名付けたオブジェクト名は以下の通りです。
「処理中...」:Message
プログレスバー:ProgressBar
パーセント表示:percent
あとはお好みで配置してください。
2.プログレスバーを処理するクラスを作成
クラスモジュールを作成します。例のクラス名は"ProgressBar"です。
ソースは以下の通りです。
Option Explicit
Const FORM_NAME As String = "Ufrm01_ProgressForm" ' 作成したフォーム名
Private done As Variant '完了したタスク項目数
Private tasks As Variant 'タスク数
Private maxWidth As Integer 'プログレスバーの横幅最大サイズ
Private frm As Object 'ユーザフォームオブジェクト
Private completionRate As Double 'タスク完了率
'********************************
'関数:Init
'
'引数
' taskCount{Variant}:総タスク数
' msg{String}:表示する文言
'
'機能:プログラスバーの生成
'********************************
Public Sub Init(ByVal taskCount As Variant, ByVal msg As String)
Set frm = VBA.UserForms.add(FORM_NAME)
done = 0
tasks = taskCount
maxWidth = frm.ProgressBar.Width
completionRate = done / tasks
If msg <> "" Then
frm.Message.Caption = msg
End If
frm.Percent.Caption = "0%"
frm.ProgressBar.Width = maxWidth * completionRate 'プログレスバーのサイズ変更
frm.Show vbModeless '処理中画面表示
DoEvents '画面制御
End Sub
'********************************
'関数:BarUpdate
'
'機能:プログレスバーの進捗更新
'********************************
Public Sub BarUpdate(ByVal updone As Variant)
done = done + updone
If tasks <= done Then
done = tasks
End If
completionRate = done / tasks
frm.percent.Caption = Format((completionRate) * 100, "0.0") & "%"
frm.ProgressBar.Width = maxWidth * completionRate 'プログレスバーのサイズ変更
DoEvents '画面制御
End Sub
'*******************************
'クラス破棄の処理
'*******************************
Private Sub Class_Terminate()
Unload frm 'フォームを閉じる
Set frm = Nothing '破棄
End Sub
3.使用例
Dim pb As ProgressBar ' プログレスバークラス
Dim i As Long ' ループ用汎用カウンタ
Set pb = New ProgressBar
Call pb.Init(3,"")
' なんかの処理
For i = 0 to 100
' 処理
pb.BarUpdate(1) 'ループ1回につき1タスク完了としてバーを更新
Next i
Set pb = Nothing ' オブジェクト破棄
上記は一例ですが好みでバーの更新タイミングやタスク完了の値を変更していただければと思います。
ループでなくても問題ありません。
余談ですが、VBAをあまり理解しておらず、Callをつけなければ構文エラーになる場面はなぜなのでしょうか。
名残でCallステートメントがあるだけで使わなくてもいいという認識でした。
色々と手抜きではありますが、参考になれば幸いです。