前々回の記事「Excel VBA ユーザフォームを使う時だけ動的に作成する」で分かったことを使い、
前回記事「Excel VBA プログレスバーをラベルで代用表示させる方法」で使用したVBAコードを組み込んでいきたいと思います。
過去記事「プログレスバーで進捗状況をビジュアルで表示する」で使った「プログレスバーコントロール」は使わないで表現するようにしていきます。
今回はプログレスバーを動的に作成して利用するようにしたいと思います。
前々回の記事で動的に UserForm を作成する方法がわかりましたが、今回は動的に作成した UserForm にコントロールとVBAコードを追加する方法を解説したいと思います(^^)
わかりました。よろしくお願いしますm(__)m
標準コントロールでプログレスバーを表現する記事がこちらです。
【この記事でわかることは】
・動的 UserForm に 動的にコントロールとVBAコードを追加する方法
・動的に作成した UserForm を起動させる方法
動的にコントロールとVBAコードを追加します
動的に作成した UserForm の CodeModule にVBAコードを書き込むと同時に各コントロールを動的に追加していきます。
動的 UserForm を作成するVBAコード
前回記事で使用したVBAコードを組み込んでいきます。わかりやすいようにコメント部分まで書き込んでいるので少し長くなっています。どうせ完了後に消してしまうからコメントはいりませんね。
Option Explicit
'プログレスバーフォームを作成する
Function ProgressFormAdd() As String
Dim Frm As VBIDE.VBComponent
Dim Ctrl As MSForms.Control
'ユーザフォームを追加
Set Frm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
With Frm
ProgressFormAdd = .Name '作成したUserForm名取得
.Properties("Caption") = "進捗状況"
.Properties("Height") = 130
.Properties("Width") = 370
With .CodeModule
'1行目は「Option Explicit」の可能性があるので外す
.InsertLines 2, "Private Declare Sub Sleep Lib ""KERNEL32"" (ByVal dwMilliseconds As Long)"
.InsertLines 3, "Public IsCancel As Boolean 'キャンセルボタン用フラグ"
'UserForm_Initializeイベント
.InsertLines 4, "Private Sub UserForm_Initialize()"
.InsertLines 5, " Caption = ""ProgressBar Sample"""
.InsertLines 6, " 'フレームとラベルの位置は同一にする"
.InsertLines 7, " With Me.Label1"
.InsertLines 8, " .Left = 0"
.InsertLines 9, " .Top = 0"
.InsertLines 10, " .width = 0"
.InsertLines 11, " .Visible = True"
.InsertLines 12, " End With"
.InsertLines 13, " 'キャンセルフラグにFalseを設定"
.InsertLines 14, " IsCancel = False"
.InsertLines 15, "End Sub"
'UserForm_Activateイベント
.InsertLines 16, "Private Sub UserForm_Activate()"
.InsertLines 17, " Dim i As Long"
.InsertLines 18, " Dim strMsg As String"
.InsertLines 19, " With Me"
.InsertLines 20, " 'マウスカーソルを待機中に固定"
.InsertLines 21, " Application.Cursor = xlWait"
.InsertLines 22, " '進捗表示用ラベルの初期表示"
.InsertLines 23, " .Label2.Caption = ""進捗状況： 0 / 100 %"""
.InsertLines 24, " strMsg = ""処理が完了しました！"""
.InsertLines 25, " 'Bar値のカウンターを初期化"
.InsertLines 26, " i = 0"
.InsertLines 27, " Do"
.InsertLines 28, " '0-100までループさせる設定"
.InsertLines 29, " If i = 100 Then Exit Do"
.InsertLines 30, " '滞留処理を実行"
.InsertLines 31, " DoEvents"
.InsertLines 32, " '処理の重さによって待機時間を要調整"
.InsertLines 33, " Sleep 50 '50ミリ秒待機に調整 1=1ミリ秒"
.InsertLines 34, " 'カウントアップ"
.InsertLines 35, " i = i + 1"
.InsertLines 36, " 'ラベル幅によって調整 350なので3.5倍している"
.InsertLines 37, " .Label1.Width = (i * 3.5)"
.InsertLines 38, " '進捗状況を％で表示（必要に応じて処理件数表示なども）"
.InsertLines 39, " .Label2.Caption = ""進捗状況："" & Format(CStr(i), ""@@@"") & "" / 100 %"""
.InsertLines 40, " 'キャンセルボタンが押された場合の処理"
.InsertLines 41, " If .IsCancel = True Then"
.InsertLines 42, " strMsg = ""処理を中断しました！"""
.InsertLines 43, " Exit Do"
.InsertLines 44, " End If"
.InsertLines 45, " Loop"
.InsertLines 46, " End With"
.InsertLines 47, " 'マウスカーソルをデフォルトに戻す"
.InsertLines 48, " Application.Cursor = xlDefault"
.InsertLines 49, " 'メッセージ表示"
.InsertLines 50, " MsgBox strMsg, vbInformation"
.InsertLines 51, " 'プログレスバーFormを閉じる"
.InsertLines 52, " Unload Me"
.InsertLines 53, "End Sub"
'コマンドボタンのイベント
.InsertLines 54, "'キャンセルボタンクリックイベント"
.InsertLines 55, "Private Sub CommandButton1_Click()"
.InsertLines 56, " 'キャンセルフラグにTrueを設定"
.InsertLines 57, " IsCancel = True"
.InsertLines 58, "End Sub"
End With
'コマンドボタン設置
Set Ctrl = .Designer.Controls.Add("Forms.CommandButton.1")
With Ctrl
.Object.Caption = "キャンセル"
'ボタンの位置をフォームの右端下にする
.Height = 36
.Width = 120
.Top = Frm.Designer.InsideHeight - Ctrl.Height - 2
.Left = Frm.Designer.InsideWidth / 2 - Ctrl.Width / 2
End With
'フレーム設置
Set Ctrl = .Designer.Controls.Add("Forms.Frame.1")
With Ctrl
.Caption = ""
.Top = 30
.Left = 6
.Height = 35
.Width = 350
.SpecialEffect = fmSpecialEffectSunken '窪み
'フレーム内にラベルを追加
Set Ctrl = .Controls.Add("Forms.Label.1")
With Ctrl
.Caption = ""
.BackColor = &H8000000D
.Top = 0 '30
.Left = 0 '6
.Height = 35
.Width = 350
End With
End With
'ラベル２をフォームに配置
Set Ctrl = .Designer.Controls.Add("Forms.Label.1")
With Ctrl
.Caption = ""
.Top = 6
.Left = 12
.Height = 18
.Width = 336
End With
End With
End Function・14～76行目までが UserForm の CodeModule にVBAコードを書き込んでいる部分です。
.InsertLines 行番号, “書き込む文字列” で順次書き込んでいます。
・32～69行目の、Private Sub UserForm_Activate() イベントへの書き込んでいるコードは、
前回記事では標準モジュールで実行していたコードをここに移動しています。
標準モジュールに UserForm を参照する記述をする方法は次回の記事で詳しく解説する予定です。
・77行目以降で、UserForm に各コントロールを追加しプロパティを設定しています。
Set Ctrl = .Designer.Controls.Add(“Forms.コントロール名.1″)
・97～105行目が、フレーム内にラベルを追加している部分です。
フレーム内で Set Ctrl = .Controls.Add(“Forms.Label.1”) とすることで、
フレームの配下にラベルを配置することができます。
動的 UserForm に書き込まれたコード
ProgressFormAdd を実行した結果、UserForm の CodeModule に書き込まれたコードです。
Option Explicit
Private Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Public IsCancel As Boolean 'キャンセルボタン用フラグ
Private Sub UserForm_Initialize()
Caption = "ProgressBar Sample"
'フレームとラベルの位置は同一にする
With Me.Label1
.Left = 0
.Top = 0
.Width = 0
.Visible = True
End With
'キャンセルフラグにFalseを設定
IsCancel = False
End Sub
Private Sub UserForm_Activate()
Dim i As Long
Dim strMsg As String
With Me
'マウスカーソルを待機中に固定
Application.Cursor = xlWait
'進捗表示用ラベルの初期表示
.Label2.Caption = "進捗状況： 0 / 100 %"
strMsg = "処理が完了しました！"
'Bar値のカウンターを初期化
i = 0
Do
'0-100までループさせる設定
If i = 100 Then Exit Do
'滞留処理を実行
DoEvents
'処理の重さによって待機時間を要調整
Sleep 50 '50ミリ秒待機に調整 1=1ミリ秒
'カウントアップ
i = i + 1
'ラベル幅によって調整 350なので3.5倍している
.Label1.Width = (i * 3.5)
'進捗状況を％で表示（必要に応じて処理件数表示なども）
.Label2.Caption = "進捗状況：" & Format(CStr(i), "@@@") & " / 100 %"
'キャンセルボタンが押された場合の処理
If .IsCancel = True Then
strMsg = "処理を中断しました！"
Exit Do
End If
Loop
End With
'マウスカーソルをデフォルトに戻す
Application.Cursor = xlDefault
'メッセージ表示
MsgBox strMsg, vbInformation
'プログレスバーFormを閉じる
Unload Me
End Sub
'キャンセルボタンクリックイベント
Private Sub CommandButton1_Click()
'キャンセルフラグにTrueを設定
IsCancel = True
End Sub標準モジュールに設定するVBAコード
実行開始はここからスタートです。
'実行開始はここから
Sub FrmMakeSample()
Dim obj As Object
Dim frmName As String
'UserForm作成しフォーム名が返る
frmName = ProgressFormAdd
'ここに実行させる作業が入る
UserForms.Add(frmName).Show
'作業完了後に作成したUserFormを削除する
For Each obj In ThisWorkbook.VBProject.VBComponents
With obj
If .Type = vbext_ct_MSForm And .Name = frmName Then
Application.VBE.ActiveVBProject.VBComponents.Remove obj
Exit For
End If
End With
Next obj
Set obj = Nothing
End Sub・6行目で、ProgressFormAdd 関数を呼び出し、作成した UserForm 名を取得しています。
・8行目の UserForms.Add(frmName).Show で UserForm を起動しています。
・UserForm をフォーム名の変数から起動させる方法についてはこの記事を参照しました。
http://officetanaka.net/excel/vba/tips/tips103.htm
実際の動作を確認します
ワークシートに「実行ボタン」を設置し、FrmMakeSample を実行できるようにしています。
実際に操作している動画がこちらです。
実行が完了するまでの動作と「キャンセル」ボタンが押されたときの動作です。
右側の VBProject に UserForm1 が出現して、処理完了後に消えていくのが確認できます。
うまくいきました(^^)/
まとめ（おわりに）
以上、VBAでプログレスバーを表示する UserForm を動的に作成・表示して、動作完了後に消してしまうことができました。
まとめと感想など
今回はサンプルのためにループ処理をプログレスバーで表示させています。今度はこれを使って、「プログレスバーで進捗状況をビジュアルで表示する」のコードを「プログレスバーコントロール」を使わないバージョンに変更してみたいと思います。
ループ処理の部分をどうやって変更するのか楽しみです。自分でもいろいろ試して考えてみたいと思います(^^)
★★★ ブログランキング参加中！ クリックしてね(^^)/ ★★★
【今後の記事について】
今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
「汎用でだれでも使えて活用できるように考えてる」というポリシーで、記事を継続して書いていきたいと思っています。どうぞよろしくお願いしますm(_ _)m
【検討中の今後の記事内容は・・・・】
・実務に役立つものを提供できるよう常に検討しています(^^ゞ
・その他雑記的に「プチネタなど」もいろいろ考えていきたいと思っています・・・・
・今後の記事にご期待ください(^^)/
過去記事のサンプルファイルをダウンロードできます
リンク先に今回記事のサンプルファイルを登録しています！
過去の記事で使用したサンプルファイルをダウンロードできるようにページを設置していますので、こちら（このリンク先）からご利用ください
【今回わかったことは】
・動的 UserForm に 動的にコントロールとVBAコードを追加する方法がわかりました
・動的の作成した UserForm をフォーム名を使って起動させる方法がわかりました