ユーザーフォーム入門
プログレスバーを自作する

Excelマクロのユーザーフォームの基礎、エクセルVBAの入門解説
公開日：2020-04-18　最終更新日：2023-03-08

第26回.プログレスバーを自作する


VBA マクロ プログレスバー


VBAで時間のかかる処理の場合、ユーザーはいつ終わるか分からずただひたすら待っているしかありません。
そのような場合はVBAの進捗を画面に表示して、今なにをしているか、後どれくらいで終わるかを知らせることで、ユーザーのイライラはかなり解消されます。


これを簡単に行うには、ステータスバーに表示する方法がありますが、
ステータスバーは若干見づらいので、今回のプログレスバーは進捗をより見やすくしたものです。
今回掲載したVBAは、使い回ししやすいようにユーザーフォームだけでプログレスバーを作成しました。

VBA マクロ プログレスバー

ただし、まずはVBA自体の処理速度向上を行う事が大前提です。

第57回.Applicationのプロパティ（マクロ高速化と警告停止等）｜VBA入門
・Applicationの主要プロパティ ・ScreenUpdating（マクロVBAの高速化） ・DisplayAlerts（警告停止） ・Interactive（ユーザー操作の禁止） ・Calculation（計算方法） ・StatusBar ・Cursor ・その他
マクロVBAの高速化・速度対策の具体的手順と検証
マクロVBAが遅い・重いという相談が非常に多いので、遅い・重いマクロVBAを高速化・速度対策する場合の具体的な手順をここに解説・検証します。マクロVBAの速度に関する記事は既にいくつか書いています。特に、以下はぜひお読みください。

ユーザーフォームの作成

VBA マクロ プログレスバー

フォームにフレームを配置してください。

VBA マクロ プログレスバー

オブジェクト名
フォーム：Progress
フレーム：FrameProgress

名前は何でも構いませんが、上記は以下のVBAで使用している名称になります。

フォームのサイズ、フレームのサイズは自由に作成して構いません。
また、他のコントロールの配置も自由に行って構いません。

ユーザーフォームのVBAコード

Option Explicit

Public isCancel As Boolean '中断時にTrueにする

Private pProgressBar As MSForms.Label 'ラベル：動的追加
Private pMaxValue As Long 'プログレスバー最大値
Private pBarColor As Long 'プログレスバー色
Private pCurValue As Double 'プログレスバー現在値
Private pInteractive As Long '割込み

'最大値プロパティ
Public Property Let MaxValue(aMaxValue As Long)
　　pMaxValue = aMaxValue
End Property
Public Property Get MaxValue() As Long
　　MaxValue = pMaxValue
End Property

'プログレスバー色プロパティ
Public Property Let BarColor(aBarColor As Long)
　　pBarColor = aBarColor
End Property

'割込み拒否プロパティ
Public Property Let Interactive(aInteractive As Boolean)
　　pInteractive = aInteractive
End Property

'フォーム表示入り口
Public Sub ShowModeless(Optional ByVal strTitle As String = "")
　　'ラベルコントロール追加
　　Set pProgressBar = Me.FrameProgress.Controls.Add("Forms.Label.1", "lblProgress")
　　If pBarColor = 0 Then pBarColor = RGB(0, 0, 128)
　　pProgressBar.Width = 0
　　pProgressBar.Height = Me.FrameProgress.Height
　　pProgressBar.BackColor = pBarColor
　　
　　'プログレスバーの背景をへこませる
　　Me.FrameProgress.SpecialEffect = fmSpecialEffectSunken
　　
　　'割込み拒否の設定
　　If pInteractive = False Then
　　　　Me.Enabled = False 'これは好みで
　　　　Application.Interactive = False
　　　　Application.EnableCancelKey = xlDisabled
　　End If
　　
　　'フォームをモードレスで表示
　　Me.Caption = ""
　　Me.Show vbModeless 'モードレス
End Sub

'プログレス進捗：指定値
Public Sub Value(ByVal aValue As Double, Optional ByVal strTitle As String = "")
　　'プログレスバー値変更
　　pCurValue = aValue
　　
　　'最大値判定
　　If pCurValue > pMaxValue Then
　　　　pCurValue = pMaxValue
　　End If
　　
　　'プログレスバーの描画
　　pProgressBar.Width = pCurValue * Me.FrameProgress.Width / pMaxValue
　　If Me.Caption <> strTitle Then
　　　　Me.Caption = strTitle
　　End If
　　
　　'再描画
　　'Me.Repaint 'これだと「応答なし」が出てしまう
　　DoEvents
End Sub

'プログレス進捗：加算
Public Sub ValueAdd(ByVal aValue As Double, Optional ByVal strTitle As String = "")
　　pCurValue = pCurValue + aValue
　　Call Value(pCurValue, strTitle)
End Sub

'フォーム終了
Public Sub SelfClose()
　　Unload Me
End Sub

'正規終了以外をキャンセル
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　　If CloseMode = vbFormControlMenu Then
　　　　If pInteractive Then
　　　　　　If MsgBox("処理を中断しますか?", vbYesNo, "中断確認") = vbYes Then
　　　　　　　　isCancel = True
　　　　　　Else
　　　　　　　　Cancel = True
　　　　　　End If
　　　　Else
　　　　　　Cancel = True
　　　　End If
　　End If
End Sub

'フォーム終了時に割込み拒否を戻す
Private Sub UserForm_Terminate()
　　If pInteractive = False Then
　　　　Application.Interactive = True
　　　　Application.EnableCancelKey = xlInterrupt
　　End If
End Sub

ShowModeless
UserForm_Initializeで行っても良いのですが、
UserForm_Initializeは引数を渡せないので、先々に拡張しやすいように引数を渡せるメソッドを使用しています。

ラベルを動的に作成して、プログレスバーとして使用しています。
プログレスバーの最大値や色はプロパティで変更できるようにしています。

Value
プログレスバーを進めるメソッドです。
Me.Repaintだけでも再描画されますが、処理時間がかかるとどうしても「応答なし」になってしまいます。
DoEventsを入れるのが一番無難ですが、処理件数が多いと余計な時間かかってしまう事にもなります。

使用側でDoEventsするなら、ここはMe.Repaintで良いかもしれません。
この辺りは、いろいろと試して使いやすいように適宜変更してください。

ValueAdd
プログレスバー値を加算で指定できるようにしています。

SelfClose
使用側でUnloadすれば良いのですが、Showを自作したので、それに対応して作成しています。

serForm_QueryClose
「×」やAlt+F4で閉じられた時の対応になります。
Interactiveプロパティで制御しています。

UserForm_Terminate
Interactive = True
この時に、Applicationのプロパティを元に戻しています。

今回掲載したVBAは、使い回ししやすいようにユーザーフォームだけでプログレスバーを作成しました。

プログレスバーのバリエーションとして、フォームをモーダル表示で行う方法もあります。
また、クラスを作成してフォームを制御する方法も良いでしょう。
この辺りの詳しい話は、以下に掲載されています。
「プログレスバー」のクラス
http://www.asahi-net.or.jp/~ef2o-inue/download/sub09_020.html

プログレスバーの使用方法1：中断不可

Sub sample1()
　　Dim Progress As New Progress
　　With Progress
　　　　.MaxValue = 100
　　　　.BarColor = RGB(0, 0, 128)
　　　　.Interactive = False '割込み不可
　　　　.ShowModeless "開始します"
　　End With
　　
　　Dim i As Long, j As Long
　　For i = 1 To Progress.MaxValue
　　　　Progress.Value i, i & "/" & Progress.MaxValue
　　　　'いろいろ処理の代わり
　　　　For j = 1 To 10000000
　　　　Next
　　Next

　　Progress.SelfClose
End Sub

単純な使用例です。
割込みを認めないようにしています。
ユーザー操作でプログレスを閉じることは出来ません。

※後日追記
エクセルブック以外のウィンドウを開いていると、
フォームを閉じた時にエクセルからフォーカスが外れて他のウィンドウの後ろに隠れてしまいます。
これに対処するには、フォームを閉じた後でAppActivateを使いエクセルをアクティブします。
Progress.SelfCloseの下に、以下のコードを追加してください。
AppActivate Application.Windows(1).Caption


プログレスバーの使用方法2：中断許可

フォルダ内の全てのファイルを処理する場合のサンプルVBAです。
まずは、テスト用データを作成します。
Sub test()
　　Dim objFSO As Object
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　
　　Dim strFolder As String
　　strFolder = ThisWorkbook.Path & "\test"
　　objFSO.CreateFolder strFolder
　　
　　Dim i As Long, j As Long
　　For i = 1 To 100
　　　　With objFSO.CreateTextFile(strFolder & "\test" & Format(i, "000") & ".txt")
　　　　　　For j = 1 To 10000
　　　　　　　　.WriteLine String(100, "A")
　　　　　　Next
　　　　　　.Close
　　　　End With
　　Next
End Sub

"test"フォルダを作成して、100文字10000行のデータを作成しています。
削除処理を入れていませんので、再実行するときはフォルダを削除してください。

上記で作成したデータを処理します。

Sub sample2()
　　Dim strFolder As String
　　strFolder = ThisWorkbook.Path & "\test"
　　
　　Dim objFSO As Object
　　Dim maxCount As Long
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　maxCount = objFSO.GetFolder(strFolder).Files.Count
　　
　　Dim Progress As New Progress
　　With Progress
　　　　.MaxValue = maxCount
　　　　.Interactive = True '割込み許可
　　　　.ShowModeless "開始します"
　　End With
　　
　　Dim objFile As Object
　　Dim strText As String
　　Dim inTs As Object
　　Dim i As Long, j As Long
　　For Each objFile In objFSO.GetFolder(strFolder).Files
　　　　
　　　　If Progress.isCancel Then
　　　　　　MsgBox "処理が中断されました。"
　　　　　　Exit Sub
　　　　End If
　　　　
　　　　i = i + 1
　　　　Progress.ValueAdd 1, i & "/" & maxCount & " : " & objFile.Name
　　　　
　　　　Set inTs = objFile.OpenAsTextStream
　　　　strText = inTs.ReadAll
　　　　inTs.Close
　　　　'いろいろ処理
　　Next

　　Progress.SelfClose
End Sub

割込みを認めるようにしています。
中断されたときは応答で続行するか確認しています。

プログレスバー自作の最後に

処理時間がそれほど長くない場合はステータスバーで十分でしょう。
処理時間が数十秒以上かかるとか、いろいろなユーザーが使うような場合は、
このようなプログレスバーを表示しておくと、ユーザーも安心すると思います。

今回掲載のVBAは、そのまま使用可能ですが、
ご自身なりに工夫して、いろいろカスタマイズして使用してみてください。


同じテーマ「ユーザーフォーム入門」の記事

第18回.２段階のコンボボックス
第19回.数値専用のテキストボックス
第20回.テキストボックスの各種イベント
第21回.ユーザーフォームの各種イベント
第22回.コントロールの動的作成
第23回.イベントプロシージャーの共通化
第24回.イベントプロシージャーの共通化（Enter,Exit）
第25回.簡易音楽プレーヤーの作成
第26回.プログレスバーを自作する
第27回.インクリメンタルサーチの実装
第28回.テンキーのスクリーンキーボード作成


新着記事NEW ・・・新着記事一覧を見る

Gemini CLIの徹底解説：AIをターミナルから使いこなす｜生成AI活用研究(2025-07-03)
Gemini CLIとPowerShellでVBAerのAI活用を加速する実践ガイド｜生成AI活用研究(2025-07-02)
「Gemini CLI」によるExcel自動化フレームワーク：実践ガイド｜生成AI活用研究(2025-07-01)
AI(Gemini)とエクセル数式対決 その3｜生成AI活用研究(2025-06-24)
不合理の砦｜AIが計算を終えた場所から、人間の価値が始まる｜生成AI活用研究(2025-06-23)
生成AIはExcelの複雑な数式を書けるのか？｜AIとの対話から学ぶ協業のリアル｜生成AI活用研究(2025-06-22)
日時データから日付ごとの集計（UNIQUE,SUMIFS,GROUPBY）｜エクセル雑感(2025-06-20)
AI時代の働き方革命：オンリーワン戦略 ― 属人化で搾取されない労働者に｜生成AI活用研究(2025-06-20)
VBA開発の標準化を実現する共通プロンプトのすすめ｜生成AI活用研究(2025-06-14)
生成AIと100本ノック 29本目：画像の挿入｜生成AI活用研究（6月13日）


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.変数宣言のDimとデータ型｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.FILTER関数（範囲をフィルター処理）｜エクセル入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
10.マクロとは？VBAとは？VBAでできること｜VBA入門



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク


↑