【VBA×WindowsAPI】不確定なプログレスバーを作成する
VBAでプログレスバーを使用する際、多くの場合、ループ回数や工程が決まっている処理に対して利用されるため、進捗状況をパーセンテージとして数値で表すことが可能です。しかし、場合によっては処理の進捗を数値化できないケースもあり、その場合はプログレスバーを進める処理を実装できません。
こうした場合に役立つのが「不確定型プログレスバー」です。このタイプのプログレスバーは、処理が進行中であることだけをユーザーに伝えるためのもので、進捗の具体的な割合を示す必要はありません。ただし、VBAの標準プログレスバーコントロールでは、不確定型プログレスバーの動作を実現することはできません。UserFormの既存コントロールを工夫して再現するのもありですが、WindowsAPIを利用することで、簡単かつ見栄えの良い不確定型プログレスバーを作成することが可能です。
不確定型プログレスバーの作成
プログレスバーは、処理や作業の進捗状況を視覚的に表現するためのUI要素です。特定のタスクが完了するまでの時間や進捗度をユーザーに伝える目的で使用されます。このプログレスバーには大きく分けて「確定型プログレスバー」と「不確定型プログレスバー」の2つの種類が存在します。
確定型プログレスバーは、処理のループ回数や工程が明確に決まっており、進捗を数値化できる場合に利用されるプログレスバーです。一方、不確定型プログレスバーは、Do～Loopのようにループ回数が明確でない処理のような、進捗を計算で求められない処理に使用されるプログレスバーです。
このうち不確定型プログレスバーはVBAの標準機能だけでは実装が難しいものですが、WindowsAPIを使うことで上動画のようにUserForm上に実装することができます。ただし、このプログレスバーはWindowsAPIを使って新たに生成されたコントロールのため、UserFormの標準コントロールとは違いオブジェクトとして存在はしません。そのため値変更や作成後の位置の変更、イベントの設定などは基本的には行うことができないので注意が必要です。(※バーの色も基本的には変更不可)
VBAで不確定型プログレスバーを作成するには下記のWindows APIを利用します。
それぞれ関数のより詳細な使い方の解説は各関数のリンクページを参照下さい。
FindWindow関数 ：ウィンドウのハンドルを取得する
CreateWindowEx関数 ：ウィンドウ(コントロール)を作成する
DestroyWindow関数 ：ウィンドウ(コントロール)を破棄する
SendMessage関数 ：ウィンドウにメッセージを送信する
GetDC関数 ：デバイスコンテキスト(DC)を取得する
ReleaseDC関数 ：指定のDCを解放する
GetDeviceCaps関数 ：デバイス情報(画面解像度)を取得する
「そもそもWindows APIって何？」という方はコチラ(メインページ)も併せて参照下さい。
サンプルコード
UserFormに不確定型プログレスバーを作成するためのサンプルコードは下記の通りです。
上画像の通り「Label1」コントロールを作成したUserFormのコードとして下記コードを使用してください。下記コードコピペ後、そのUserFormを表示するだけでLabel1の位置に不確定型プログレスバーが作成され、アニメーションが始まります。不確定型プログレスバーは確定型とは違い、アニメーションが無限にループするだけなので、処理の途中にカウントを増やすなどの処理は不要です。(※処理中にアニメーションが止まる場合は、ループ内にDoEventsを入れることで問題が解消します。)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 |
Option Explicit Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long Private Const WS_CHILD As Long = &H40000000 Private Const WS_VISIBLE As Long = &H10000000 Private Const PBS_MARQUEE As Long = &H8 Private Const PBM_SETMARQUEE As Long = &H40A Private hWndProg As LongPtr '------------------------------------------------------------------ '- UserForm起動時ｲﾍﾞﾝﾄ '------------------------------------------------------------------ Private Sub UserForm_Initialize() Dim hWndForm As LongPtr 'UserFormのｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ取得 hWndForm = FindWindow("ThunderDFrame", Me.caption) 'ｶﾞｲﾄﾞのﾗﾍﾞﾙは非表示 Me.Label1.Visible = False 'ﾌﾟﾛｸﾞﾚｽﾊﾞｰ作成(ﾏｰｷｰｽﾀｲﾙ) hWndProg = CreateWindowEx(0, "msctls_progress32", vbNullString, _ WS_VISIBLE Or WS_CHILD Or PBS_MARQUEE, _ PtToPx(Me.Label1.Left), PtToPx(Me.Label1.Top), _ PtToPx(Me.Label1.Width), PtToPx(Me.Label1.Height), _ hWndForm, 0, 0, 0) 'ｱﾆﾒｰｼｮﾝ開始 Call StartAnimation(20) 'ｱﾆﾒｰｼｮﾝ停止 'Call StoptAnimation(20) End Sub '------------------------------------------------------------------ '- UserForm終了時ｲﾍﾞﾝﾄ '------------------------------------------------------------------ Private Sub UserForm_Terminate() Call DestroyWindow(hWndProg) End Sub '------------------------------------------------------------------ '- ｱﾆﾒｰｼｮﾝ開始 '------------------------------------------------------------------ Private Sub StartAnimation(ByVal dMilliseconds As Double) Call SendMessage(hWndProg, PBM_SETMARQUEE, 1, dMilliseconds) End Sub '------------------------------------------------------------------ '- ｱﾆﾒｰｼｮﾝ停止 '------------------------------------------------------------------ Private Sub StopAnimation() Call SendMessage(hWndProg, PBM_SETMARQUEE, 0, 0) End Sub '------------------------------------------------------------------ '- ﾎﾟｲﾝﾄ(pt)→ﾋﾟｸｾﾙ(px)変換 '------------------------------------------------------------------ Function PtToPx(ByVal dPt As Double) As Double Dim hDC As LongPtr Dim lDpiX As Long hDC = GetDC(0) lDpiX = GetDeviceCaps(hDC, 88) '88 = LOGPIXELSX Call ReleaseDC(0, hDC) PtToPx = dPt * lDpiX / 72 End Function |
コード解説
ウィンドウハンドルを取得する
ウィンドウにはそれぞれを識別するためにウィンドウハンドルと呼ばれるIDが割り当てられています。WindowsAPIでウィンドウの情報を取得したり操作する際には、このウィンドウハンドルを使って行います。今回のケースでは、プログレスバーを作成する場所の情報として必要になります。
ウィンドウハンドルを取得する方法はいくつも存在しますがここでは常套手段のFindWindow関数を使ってウィンドウハンドルを取得しています。FindWindow関数は下記のように記載することで指定のクラス名もしくはウィンドウ名から該当のウィンドウへのハンドルを取得することができます。(UserFoemの場合はクラス名に「”ThunderDFrame”」、ウィンドウ名に「Me.Caption」で取得可能)
hWnd = FindWindow(“クラス名”, “ウィンドウ名”)
不確定型プログレスバー作成
Windowsにはツールバーやステータスバー、ツリービューをはじめとした「コモンコントロール」と呼ばれるコントロール群が登録されており、プログレスバーもこのコモンコントロールに含まれています。コモンコントロールを新規作成する場合はCreateWindowEx関数を使います。
|
1 2 3 4 5 6 7 8 |
'ﾌﾟﾛｸﾞﾚｽﾊﾞｰ作成(ﾏｰｷｰｽﾀｲﾙ) hWndProg = CreateWindowEx(0, "msctls_progress32", vbNullString, _ WS_VISIBLE Or WS_CHILD Or PBS_MARQUEE, _ PtToPx(Me.Label1.Left), PtToPx(Me.Label1.Top), _ PtToPx(Me.Label1.Width), PtToPx(Me.Label1.Height), _ hWndForm, 0, 0, 0) |
引数は非常に多く、基本的には上記の通り記載すれば問題ありません。
このとき、値を変えることのある引数は第4～8引数で、それ以外は基本的に定数値です。
第4引数には作成するコントロールのウィンドウスタイルを入力していますが、不確定プログレスバーの場合は「PBS_MARQUEE」を設定する必要があります。この値を設定することでプログレスバーは「マーキースタイル」が適用され不確定プログレスバーとして設定することができます。
第5～8引数は作成するコントロールの位置と大きさを入力します。サンプルコードでは事前に作成しておいたLabelと同じ位置、サイズになるような値を入力しています。本関数の入力値の単位はピクセル(px)のため、UserForm上の単位ポイント(pt)を変換するための関数を通しています。位置調整のためにLabelを用意していますが、定数を直接入力しても問題ありません。
CreateWindowEx関数で作成したコントロールは不要になったら、DestroyWindow関数を使って明示的に破棄する必要があります。本関数を通さずに処理を終えてしまうとメモリリークを起こす原因となるため注意が必要です。(サンプルコードではTerminateイベントで実行)
Call DestroyWindow(hWndDate)
引数として破棄するコントロール(ウィンドウ)のハンドルを入力します。CreateWindowEx関数は作成したコントロールのウィンドウハンドルを戻り値として返すため、その値をそのまま入力すれば作成した日付選択コントロールを破棄することができます。
アニメーションの開始/停止
不確定型プログレスバーのアニメーションを開始するにはSendMessage関数を使って下記のように記載します。本処理を実行することで以降はプログレスバーのアニメーションが無限にループします。
Call SendMessage(hWndProg, PBM_SETMARQUEE, 1, dMilliseconds)
第1引数には作成したプログレスバーのウィンドウのハンドル、第2引数にはアニメーション設定するための定数値「PBM_SETMARQUEE」、第3引数にはアニメーションを開始するという意味の「1」、第4引数にはアニメーションの更新間隔をミリ秒単位で指定します。基本的には決まった値になってきますが、第4引数に関してはアニメーションの速度を任意で入力することが可能です。
基本的に処理が終了したらウィンドウそのものを閉じるため、あまり利用頻度は高くないですが、アニメーションを停止する際は開始時と同じくSendMessage関数を使って下記のように記載します。
Call SendMessage(hWndProg, PBM_SETMARQUEE, 0, 0)
停止の場合は第1,第2引数は開始と同じ値を入力し、第3,4引数はいずれも0を入力します。
関連情報
VBA×WindowsAPIまとめページ
その他のWindowsAPI関数は下記ページにまとまっているので合わせて参照下さい。
https://liclog.net/vba-windows-api-index/参考
Microsoft公式：進行状況バー コントロールについて – Win32 apps
