ExcelVBAにて時間がかかる処理を行う場合に、プログレスバーを表示して途中経過を出す方法をご説明します。
なお、簡易的にステータスバーに途中経過を出す方法は、以下の記事をご覧ください。
プログレスバーを使う準備
プログレスバーを使うには、まずはユーザーフォームを作って、フォーム上にプログレスバーを配置する必要があります。
①Visual Basic Editorの画面で、[挿入]→[ユーザーフォーム] を選ぶと、ユーザーフォームが作成されます。
②[ツール]→[その他のコントロール] を選ぶと、[コントロールの追加]画面が表示されます。
③[利用可能なコントロール] から[Microsoft ProgressBar Contorol] を選択して [OK] をクリックすると、[ツールボックス]にプログレスバーが追加されます。
④先ほどツールボックスに追加したプログレスバーを、ユーザーフォームに追加します。
⑤プログレスバーを選択した状態で、プロパティ画面で、追加したプログレスバーの[オブジェクト名]を確認しておきます。（あとで使います。）
なお、[オブジェクト名]は必要に応じて変更できます。
⑥また、見た目を良くするために、[Scrolling]を「0 – ccScrollingStandard」→「1 – ccScrollingSmooth」に変えておきます。
⑦フォームの大きさを調整します。
プログレスバーが無い場所をクリックすると、フォームの大きさを調整できるようになります。
⑧フォーム全体を選択した（プログレスバーが無い場所をクリックする）状態で、プロパティ画面で、フォームの[オブジェクト名]を確認しておきます。（あとで使います。）
なお、[オブジェクト名]は必要に応じて変更できます。
また、[Caption]がフォームのタイトルバーに表示される文字になりますので、必要に応じて変更しておきます。
これで、プログレスバーを使う準備が出来ました。
プログレスバーの使い方
ステータスバーの説明記事（以下の記事）でも使った「FizzBuzz問題」を使って、プログレスバーを作りました。
【Excel VBA】途中経過の表示方法（StatusBar）
説明は、下記ソースのコメントに記載しましたので、ご参照ください。
Sub FizzBuzzProgress()
Dim Idx1 As Long
'--------------------------------------------------
'初期設定
'--------------------------------------------------
'フォームを表示
'vbModeless を付けないと、フォームが出たまま処理が止まってしまいます。
UserForm1.Show vbModeless
'プログレスバーの最大値を設定
'以下の処理で10万行の処理をするため、「100000」を設定
UserForm1.ProgressBar1.Max = 100000
'プログレスバーの初期値「0」を設定
UserForm1.ProgressBar1.Value = 0
'制御をOSに戻す（これをやらないと初期設定がフォームに反映されません）
DoEvents
'--------------------------------------------------
'FizzBuss問題
'--------------------------------------------------
For Idx1 = 1 To 100000
'A列：数字を表示
Sheets("Sheet1").Cells(Idx1, 1) = Idx1
'B列：FizzBussの答えを表示
If Idx1 Mod 3 = 0 And Idx1 Mod 5 = 0 Then
Sheets("Sheet1").Cells(Idx1, 2) = "Fizz Buzz"
ElseIf Idx1 Mod 3 = 0 Then
Sheets("Sheet1").Cells(Idx1, 2) = "Fizz"
ElseIf Idx1 Mod 5 = 0 Then
Sheets("Sheet1").Cells(Idx1, 2) = "Buzz"
Else
Sheets("Sheet1").Cells(Idx1, 2) = Idx1
End If
'------------------------------------------------------
'数字（行番号）が千の倍数のときに、プログレスバーを更新
'------------------------------------------------------
If Idx1 Mod 1000 = 0 Then
'プログレスバーに、行番号「Idx1」を設定
UserForm1.ProgressBar1.Value = Idx1
End If
Next
'--------------------------------------------------
'処理終了後、フォームを消去
'--------------------------------------------------
Unload UserForm1
End Sub実行すると、こんな感じのフォームが表示されます。
処理が完了すると、フォームが消えます。
コメント