0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

ExcelVBAで進捗バーを自作

Last updated at Posted at 2024-07-16

VBAにて作業進捗度を可視化するプログレスバーを自作します。ツール>参照設定からプログレスバーの用意はされているかと思いますが、バージョンによって使えなかったりなど不便かと思いますので、面倒なことは抜きに簡易的に自作しました。
ちなみにですが手抜きです。参考までにしていただき、お好みで改変などしていただければと思います。

1.フォームで進捗バーの画面を作成

image.png
今回はこんな感じのプログレスバーの画面を作成しました。非常にシンプルです。
フォーム名は"Ufrm01_ProgressForm"にしました。
用意したオブジェクトはたったの3つで、「処理中...」の表示と、バーと、パーセント表示する3つのLabelオブジェクトだけです。
今回こちらで名付けたオブジェクト名は以下の通りです。

「処理中...」:Message
プログレスバー:ProgressBar
パーセント表示:percent

あとはお好みで配置してください。

2.プログレスバーを処理するクラスを作成

クラスモジュールを作成します。例のクラス名は"ProgressBar"です。
ソースは以下の通りです。

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ステートメントがあるだけで使わなくてもいいという認識でした。

色々と手抜きではありますが、参考になれば幸いです。

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?