【VBA×WindowsAPI】UserFormのサブクラス化とウィンドウプロシージャ設定

VBAでUserFormを使った開発をしているときに「このイベントがあったらいいな」と思うことはしばしばあります。例えばマウスの中ボタンクリックのイベントやマウスホイールの回転イベント、ファイルのドラッグ＆ドロップのイベントなど様々です。

この問題はWindowsAPIの関数を使うことで解決することができますが、コードとしては本来VBAでは扱うことの無いプログラムの深部までアクセスすることになるため、かなり上級者向けの内容となっています。機能としてはメリットもデメリットもある手法にはなるため、どちらも理解したうえで実際に使うのか否かを各自で判断する必要があります。

1. ウィンドウプロシージャとサブクラス化
2. UserFormイベントの追加
- 2.1. コード解説
3. 新規イベント実装例
4. 関連情報

ウィンドウプロシージャとサブクラス化

ウィンドウプロシージャ

Windowsのすべてのウィンドウには「ウィンドウプロシージャ(WNDPROC)」というウィンドウメッセージを処理するための関数が設定されています。ウィンドウメッセージは、その名の通りウィンドウに送信されるメッセージです。内部的な動きとしてユーザーが行うさまざまなアクションに応じて「ウィンドウがクリックされた」「ウィンドウのサイズが変更された」「キーボードが押された」「マウスホイールが回された」のようなメッセージが送信されています。

ウィンドウメッセージはSpy++などの専用ツールを利用することで調べることができます。上画像の1行1行がウィンドウメッセージであり、「WM_○○○」部分が受信したメッセージの内容を表しています。たとえば「WM_MOVE」はウィンドウが移動された時に送信されるメッセージです。

これらのウィンドウメッセージを受け取り、それぞれのアクション別に処理を振り分けている関数がウィンドウプロシージャであり、UserFormイベントの根源部分の処理といってもよいでしょう。

サブクラス化

UserFormのウィンドウプロシージャは既に定義されているもののため、特定のメッセージを受信したときに新たな処理を追加したいとしても、その処理を書き換えることはできません。

このような場合に利用される手法が「ウィンドウのサブクラス化」です。
ウィンドウのサブクラス化とは、既存のウィンドウプロシージャの処理はそのままで、新たに定義した関数(WNDPROC)をその既存の処理に割り込ませる設定をすることをいいます。これにより、指定のウィンドウメッセージを受信したときに任意の処理を行わせることが可能になりつつも、それ以外のメッセージを受信した場合は既存のウィンドウプロシージャに処理を任せることができます。

VBAではSetWindowLongPtr関数を使うことで、VBAで定義したFunctionプロシージャを設定することができます。このときFunctionプロシージャの名称に決まりはありませんが、引数の数や型、コード内容には決まりがあるため、そのルールに従って定義する必要があります。

注意

VBAでのサブクラス化はUserFormに対して様々なイベントを追加することができる反面、取り扱いが非常に難しい代物なので細心の中を払って実装する必要があります。
　
サブクラス化を行う場合、ルールとしてそのサブクラスの終了処理も併せて行う必要があります。
終了処理を通らずにコードを終了してしまうとアプリケーション(Excel等)が強制終了されます。また、デバッグとしてブレークポイントで処理を一時停止した場合や、デバッグエラーで処理が停止した場合も、正常に終了処理がされていないと見なされアプリケーションは強制終了されます。
　　
つまり、サブクラス化を行う場合は必ず終了処理が行われるようなコードを書く必要があるということです。アプリケーションが何度も落ちたり、ブレークポイントを設定できなかったりと開発の難易度はかなり高いですが、正しいコードが書ければその強力な恩恵を享受することができます。

UserFormイベントの追加

下記はUserFormウィンドウをサブクラス化して新たなウィンドウプロシージャを追加、つまりは新たなイベントを追加するためのサンプルコードです。基本的にはWndProc関数の「Case WM_○○○」に対象のウィンドウメッセージを入力するだけでイベントの追加が可能です。

たとえば、ウィンドウ上でマウスホイール(中ボタン)がクリックされた時に送信されるメッセージ「WM_MBUTTONDOWN(&H207)」を条件分岐に含めることで、マウスホイールがクリックされた時に発動する処理を定義することができます。(※その他メッセージはウィンドウメッセージ一覧を参照)

標準モジュールコード

Option Explicit
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Public Const GWLP_WNDPROC = -4
Public Const WM_MBUTTONDOWN = &H207

Public lpPrevWndProc As LongPtr

'------------------------------------------------------------------------------
'   ﾒｲﾝ処理
'------------------------------------------------------------------------------
Sub main()

    UserForm1.Show

End Sub

'------------------------------------------------------------------------------
'   WINPROCｺｰﾙﾊﾞｯｸ関数
'------------------------------------------------------------------------------
Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    
    Select Case uMsg
    
    'ﾏｳｽﾎｲｰﾙ(中ﾎﾞﾀﾝ)ｸﾘｯｸｲﾍﾞﾝﾄ
    Case WM_MBUTTONDOWN
    
        Call MsgBox("ホイールが押下されました", vbInformation)
        Exit Function
        
'    Case WM_○○○
'
'        ｳｨﾝﾄﾞｳﾒｯｾｰｼﾞに対する処理
'        Exit Function

    End Select
    
    WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
    
End Function

Option Explicit

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Public Const GWLP_WNDPROC = -4

Public Const WM_MBUTTONDOWN = &H207

Public lpPrevWndProc As LongPtr

'------------------------------------------------------------------------------

' ﾒｲﾝ処理

'------------------------------------------------------------------------------

Sub main()

UserForm1.Show

End Sub

'------------------------------------------------------------------------------

' WINPROCｺｰﾙﾊﾞｯｸ関数

'------------------------------------------------------------------------------

Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Select Case uMsg

'ﾏｳｽﾎｲｰﾙ(中ﾎﾞﾀﾝ)ｸﾘｯｸｲﾍﾞﾝﾄ

Case WM_MBUTTONDOWN

Call MsgBox("ホイールが押下されました", vbInformation)

Exit Function

' Case WM_○○○

' ｳｨﾝﾄﾞｳﾒｯｾｰｼﾞに対する処理

' Exit Function

End Select

WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)

End Function

UserFormコード

Option Explicit

Dim hWnd As LongPtr

'------------------------------------------------------------------------------
'   UserForm起動時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------------------
Private Sub UserForm_Initialize()

    'UserFormのｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙを取得
    hWnd = FindWindow("ThunderDFrame", Me.Caption)
    hWnd = FindWindowEx(hWnd, 0, vbNullString, vbNullString) 'ｸﾗｲｱﾝﾄ領域を取得

    'UserFormにｳｨﾝﾄﾞｳﾌﾟﾛｼｰｼﾞｬを設定 (ｻﾌﾞｸﾗｽ化)
    lpPrevWndProc = SetWindowLongPtr(hWnd, GWLP_WNDPROC, AddressOf WndProc)
    
End Sub

'------------------------------------------------------------------------------
'   UserForm終了時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------------------
Private Sub UserForm_Terminate()

    'UserFormのｳｨﾝﾄﾞｳﾌﾟﾛｼｰｼﾞｬを元に戻す
    Call SetWindowLongPtr(hWnd, GWLP_WNDPROC, lpPrevWndProc)

End Sub

Option Explicit

Dim hWnd As LongPtr

'------------------------------------------------------------------------------

' UserForm起動時ｲﾍﾞﾝﾄ

'------------------------------------------------------------------------------

Private Sub UserForm_Initialize()

'UserFormのｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙを取得

hWnd = FindWindow("ThunderDFrame", Me.Caption)

hWnd = FindWindowEx(hWnd, 0, vbNullString, vbNullString) 'ｸﾗｲｱﾝﾄ領域を取得

'UserFormにｳｨﾝﾄﾞｳﾌﾟﾛｼｰｼﾞｬを設定 (ｻﾌﾞｸﾗｽ化)

lpPrevWndProc = SetWindowLongPtr(hWnd, GWLP_WNDPROC, AddressOf WndProc)

End Sub

'------------------------------------------------------------------------------

' UserForm終了時ｲﾍﾞﾝﾄ

'------------------------------------------------------------------------------

Private Sub UserForm_Terminate()

'UserFormのｳｨﾝﾄﾞｳﾌﾟﾛｼｰｼﾞｬを元に戻す

Call SetWindowLongPtr(hWnd, GWLP_WNDPROC, lpPrevWndProc)

End Sub

※前述の注意書きの通り、上記コードを終了する際は必ずUserFormの[×]ボタンを押して終了してください。また、WndProc関数内にブレークポイントを置いたり、WndProc関数内でデバッグエラーを起こさないよう細心の注意を払って実行してください。

コード解説

WndProc関数の定義

追加で設定するウィンドウプロシージャをFunctionプロシージャで定義します。
関数名に決まりはありませんが引数は下記の通りの設定が必要です。基本的にコードの内容はルールで決まっているため、下記コードをそのままコピペしてSelect Case内にウィンドウメッセージごとの処理を記載するだけで、新たなUserFormイベントを追加することができます。

'------------------------------------------------------------------------------
'   WINPROCｺｰﾙﾊﾞｯｸ関数
'------------------------------------------------------------------------------
Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    Select Case uMsg

'    Case WM_○○○
'
'        ｳｨﾝﾄﾞｳﾒｯｾｰｼﾞに対する処理
'        Exit Function

    End Select

    WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)

End Function

'------------------------------------------------------------------------------

' WINPROCｺｰﾙﾊﾞｯｸ関数

'------------------------------------------------------------------------------

Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Select Case uMsg

' Case WM_○○○

' ｳｨﾝﾄﾞｳﾒｯｾｰｼﾞに対する処理

' Exit Function

End Select

WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)

End Function

ウィンドウが受信したメッセージは引数「uMsg」経由で送られてくるので、追加したいイベントごとに条件分岐で処理を振り分けることができます。またウィンドウメッセージによってはその他の情報も併せて受信することがあり、それらの情報は「wParam」「lParam」経由で本関数内に入力されます。

指定のウィンドウメッセージが受信されず、WndProc関数内で処理を何も行っていないような場合、CallWindowProc関数を使い既存のウィンドウプロシージャに処理を戻す必要があります。

CallWindowProc関数

WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)

第1引数の「lpPrevWndProc」は既存のウィンドウプロシージャで、SetWindowLongPtr関数での戻り値となります。第2～第5引数はWndProc関数の引数をそのまま入力するだけです。
　

ウィンドウハンドルを取得する

ウィンドウにはそれぞれウィンドウハンドルと呼ばれる、ウィンドウを識別するためのID情報のようなものが付与されています。このウィンドウハンドルを取得することで、”どの”ウィンドウに対して処理を行うのかを簡単に指示することができます。(Windows APIでは頻出ワードです)

新たなウィンドウプロシージャを設定するには対象のウィンドウのハンドルを取得する必要があります。サンプルコードでは中クリックのメッセージを取得していますが、中クリックのメッセージを受け取るウィンドウはUserFormのウィンドウではなく、UserFormのクライアント領域となります。

そのため、FindWindow関数とFindWindowEx関数を使い、UserFormのクライアント領域にあたるエリアのウィンドウハンドルを取得しています。メッセージを受け取る対象のウィンドウはメッセージによりさまざまなので、Spy++等のツールを使って調べる必要があります。
　

ウィンドウプロシージャ設定

前項で取得したウィンドウに対し、WndProc関数をウィンドウプロシージャとして設定します。
ウィンドウプロシージャの設定はSetWindowLongPtr関数を使い下記のように書きます。

WndProc設定

Proc = SetWindowLongPtr(hWnd, GWLP_WNDPROC, AddressOf WndProc)

第1引数の「hWnd」にはウィンドウプロシージャを設定する対象のウィンドウハンドルを、第2引数には設定する情報がウィンドウプロシージャであることを表す定数値「GWLP_WNDPROC」を、第3引数には設定するウィンドウプロシージャ(WndProc)をAddressOf演算子経由でそれぞれ入力します。

これにより「hWnd」が示すウィンドウのサブクラス化が行われます。
このとき、戻り値の「Proc」はデフォルトでUserFormが持っていたウィンドウプロシージャです。この情報はWndProc内のCallWindowProc関数の引数や、サブクラス化の終了処理で利用するため保持しておく必要があります。

サブクラス化したウィンドウが不要になった場合、終了処理を行う必要があります。終了処理はSetWindowLongPtr関数の第3引数にデフォルトのウィンドウプロシージャを設定するだけで、それ以外はサブクラス化の時と同じです。終了処理を行わないとアプリケーションが強制終了されるため必ずこの処理を通るようなコードで実装してください。