ユーザーフォーム入門
ListBox・ComboBoxをマウスホイール対応させる

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

第29回.ListBox・ComboBoxをマウスホイール対応させる


ユーザーフォームに配置した「ListBox」や「ComboBox」は、標準状態ではマウスホイールによるスクロール操作に対応していません。
大量のデータを選択するフォームでは、スクロールバーを直接ドラッグしなければならず、操作性の面で大きな課題となります。


ネット上には Windows API（WH_MOUSE_LL）を使用したスクロール化コードがいくつか存在しますが、
「コンボボックスが閉じているのに画面外でスクロールが続いてしまう」「64bit環境で動作しない」「WindowsのDPI（画面拡大率）を変えると判定がズレる」
といった課題を抱えているものが少なくありません。
本記事では、これらの問題をクリアし、コンボボックスのドロップダウン展開状態まで厳密に判定する、【完全版】といえるVBAコードを公開・解説します。

※本記事のVBAコードおよび解説文章の多くは、生成AI（ChatGPT、Gemini、Claude）を活用して作成しました。VBA動作や解説文の最終的な内容は人間による確認・編集を経て掲載しています。


ページ内目次

本モジュールで解決できること
機能概要
ユーザーフォームのサンプルとVBA
標準モジュールのVBA
VBAコードの詳細解説
使用しているWindows APIの解説


本モジュールで解決できること

既存のマウスホイール対応コードで発生しがちだった各種問題を、本モジュール（ModMouseWheel）では極力解決しています。
  • ListBox対応
    フォーム上のリストボックスにおいて、マウスホイールによるスムーズな上下スクロールを実現します。
  • ComboBox対応
    コンボボックスの選択項目切り替え、および展開時のドロップダウンリストのスクロールに対応します。
  • ドロップダウン開閉判定
    コンボボックスの展開状態をリアルタイムで検知し、開いている時・閉じている時で最適な操作対象を自動切り替えします。
  • DPI対応（画面拡大率）
    Windowsのディスプレイ設定（125%や150%などの拡大率）に関わらず、マウスの位置判定がズレません。
  • 複雑なコンテナネスト（MultiPage / Frame）対応
    MultiPageやFrameの中に配置されたコントロールであっても、親コンテナを遡って原点を自動計算するため正確に領域を割り出します。
  • 32bit / 64bit完全対応
    PtrSafe および LongPtr を適切に実装しているため、Officeのビット数を問わずそのまま動作します。
  • 誤スクロール防止
    リストやドロップダウンの枠外にマウスがある時は動作を遮断し、裏にある関係のない画面が勝手に動くのを防止します。
  • 再入防止（再帰呼び出しガード）
    ホイールの高速回転時に処理が重なってExcelがフリーズ・フック落ちするのを、実行中フラグにより完全に防ぎます。


機能概要

本モジュール（ModMouseWheel）は、Windows APIの低レベルマウスフック（WH_MOUSE_LL）を使用し、UserForm上のコントロールにマウスホイール操作を組み込みます。
単にスクロールさせるだけでなく、「マウスカーソルが今どこにあるか」 を高精度に判定することで、直感的で誤作動のない操作感を実現しています。

コントロールごとのスクロール挙動とマウス位置判定

  • ListBox（リストボックス）
    • マウス位置: マウスカーソルが ListBox の枠内（表示領域）にある時のみスクロールが機能します。
    • 挙動: ホイールの回転方向に合わせてリストが3行ずつ上下にスクロールします（SCROLL_ROWS 定数で変更可能）。枠外へ出ると即座にスクロールが停止します。

  • ComboBox（コンボボックス）
    • ドロップダウン非展開時（閉じている状態）
      • マウス位置: マウスカーソルが ComboBox 本体の枠内にある時のみ機能します。
      • 挙動: ホイールを回転させると、ドロップダウンを開かずに選択項目（ListIndex）が前後に切り替わります。枠外へ移動すると操作を受け付けなくなります。

    • ドロップダウン展開時（リストが開いている状態）
      • マウス位置: 画面上に展開されたドロップダウンリストの枠内にある時のみ機能します。
      • 挙動: 展開されたリスト内をスムーズにスクロールできます。マウスカーソルをドロップダウンリストの枠外へ動かした瞬間にスクロールが停止するため、裏にある他のコントロールやフォームを誤ってスクロールさせてしまう心配がありません。

技術的な特長（完成度を高める工夫）

  • ドロップダウン領域のピンポイント特定（GW_OWNER 判定）
    コンボボックス展開時にWindowsが一時生成するポップアップウィンドウの所有者（Owner）関係を GetWindow(hwnd, GW_OWNER) で追跡し、「今開いているドロップダウン領域」の絶対画面座標を正確に割り出します。ドロップダウンが閉じている時や枠外操作時の誤作動、裏画面の誤スクロールを完全に遮断します。

  • DPIスケーリング・高DPI環境への完全対応（論理座標変換）
    Windowsのディスプレイ設定（拡大/縮小 125%、150%など）に合わせて、VBA内部のポイント単位（pt）とAPIのピクセル単位（px）の変換係数を自動算出します。さらに、OSフックで取得した物理座標を PhysicalToLogicalPointForPerMonitorDPI API で即座に論理座標へ変換するため、高解像度モニターやマルチモニター環境でも判定座標が一切ズレません。

  • MultiPage・Frame「深層ネスト」の階層再帰探索
    コントロールが Frame や MultiPage 内に何重にもネスト配置されている場合でも、専用の逆引き関数による再帰探索で最上位フォームまで階層を遡ります。各Frameの枠線厚みやMultiPageのタブ見出し高さなどを正確に加算し、複雑なフォーム構造であってもコントロールの画面上の絶対領域を正しく特定します。

  • 二重実行防止と自動解体の「二重安全ガード」
    ホイールの高速回転時に処理が重ならないよう内部フラグ（IsProcessing）による再入防止を行っています。また、フック処理時に IsWindow API でフォームの生存確認を常時行い、フォーム閉鎖を検知した場合はその場で安全かつ自動的にフックを解除してExcelのクラッシュを防ぎます。

  • 32bit / 64bit 完全対応
    PtrSafe および LongPtr を適正に使用しており、Office 2010 以降のすべての環境（32bit / 64bit）でそのまま動作します。


ユーザーフォームのサンプルとVBA

動作確認用のサンプルフォームを作成します。

コントロールの配置

UserForm を作成し、以下のコントロールを配置します。
  • ListBox1（リストボックス）
  • ComboBox1（コンボボックス）

ListBox・ComboBoxをマウスホイール対応するVBA サンプル


UserFormのコード

フォームのモジュールに以下のコードを記述します。
マウスがコントロールの上に乗った（MouseMove）タイミングでフックを開始し、フォームを閉じる際や非アクティブ化時にフックを安全に解除します。

Option Explicit

Private Sub UserForm_Initialize()
　　Dim i As Long
　　For i = 1 To 100
　　　　Me.ComboBox1.AddItem "コンボ項目 " & i
　　　　Me.ComboBox2.AddItem "コンボ項目 " & i
　　　　Me.ComboBox3.AddItem "コンボ項目 " & i
　　　　Me.ListBox1.AddItem "リスト項目 " & i
　　　　Me.ListBox2.AddItem "リスト項目 " & i
　　　　Me.ListBox3.AddItem "リスト項目 " & i
　　Next i
End Sub

' ListBox 上にカーソルが乗ったらフック対象に設定
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　　Call StartMouseHook(Me.ListBox1)
End Sub
Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　　Call StartMouseHook(Me.ListBox2)
End Sub
Private Sub ListBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　　Call StartMouseHook(Me.ListBox3)
End Sub

' ComboBox 上にカーソルが乗ったらフック対象に設定
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　　Call StartMouseHook(Me.ComboBox1)
End Sub
Private Sub ComboBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　　Call StartMouseHook(Me.ComboBox2)
End Sub
Private Sub ComboBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　　Call StartMouseHook(Me.ComboBox3)
End Sub


' フォームが閉じられる直前にフックを終了
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　　Call StopMouseHook
End Sub

' フォーム終了時にフックを終了
Private Sub UserForm_Terminate()
　　Call StopMouseHook
End Sub

※対象コントロールが多い場合は、イベントプロシージャーの共通化を検討してください。
第23回.イベントプロシージャーの共通化
・サンプルのユーザーフォーム ・イベントプロシージャーの共通化のVBA ・イベントプロシージャーの共通化の問題点 ・イベントプロシージャーの共通化の雛形VBA ・イベントプロシージャーの共通化の最後に


標準モジュールのVBA

標準モジュールに以下のコードを貼り付けます。
以下のコメントではモジュール名を指定していますが、実際にはモジュール名は任意です。

Option Explicit

'===============================================================================
' モジュール名 : ModMouseWheel
' 概要　　　　 : WH_MOUSE_LL（低レベルマウスフック）を使用した
'　　　　　　　　UserForm 上の ListBox / ComboBox マウスホイールスクロール制御
' 備考　　　　 : ・Office 2010 以降（32bit / 64bit）対応
'　　　　　　　　・GW_OWNER 判定による ComboBox ドロップダウン領域の特定
'　　　　　　　　・MultiPage (ClientLeft/ClientTop) や Frame (InsideWidth/Height)
'　　　　　　　　　の内部原点自動算出による高精度な座標判定
'　　　　　　　　・Page.Parent が MultiPage を返さない仕様に対応し、
'　　　　　　　　　MultiPage を明示的に逆引きして原点計算に含めるよう対応
'　　　　　　　　・TypeOf ページオブジェクト Is MSForms.UserForm の誤判定を回避するため
'　　　　　　　　　中間コンテナ型を肯定条件で列挙して階層追跡を実行
'　　　　　　　　・ディスプレイ拡大率（DPI）が100%を超える環境向けに、
'　　　　　　　　　マウスフック座標を PhysicalToLogicalPointForPerMonitorDPI で
'　　　　　　　　　論理座標に変換してから判定するよう対応
'　　　　　　　　・MSForms.MultiPage / Page のプロパティ参照エラー(エラー438)回避のため
'　　　　　　　　　MultiPage自身のLeft/Topに近似オフセット定数を加算する方式で原点を算出
'　　　　　　　　・[安全対策] フォーム破棄時の自動解体ガード(IsWindow)および
'　　　　　　　　　フックチェーン断絶防止ロジックを MouseProc に組み込み済み
'===============================================================================


'===============================================================================
'　Windows API 宣言
'===============================================================================

' --- フック関連 API ---

' 低レベルフックプロシージャをフックチェーンに登録する関数
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
　　ByVal idHook As Long, _
　　ByVal lpfn As LongPtr, _
　　ByVal hmod As LongPtr, _
　　ByVal dwThreadId As Long) As LongPtr

' 登録したフックプロシージャをフックチェーンから解除する関数
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
　　ByVal hHook As LongPtr) As Long

' フックチェーン内の次のフックプロシージャへメッセージを転送する関数
Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
　　ByVal hHook As LongPtr, _
　　ByVal nCode As Long, _
　　ByVal wParam As LongPtr, _
　　ByVal lParam As LongPtr) As LongPtr


' --- メモリ・描画 (DPI計算) 関連 API ---

' メモリ領域間でデータをコピーする関数（構造体のデコンパイル用）
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
　　Destination As Any, _
　　Source As Any, _
　　ByVal Length As LongPtr)

' 指定されたウィンドウのデバイスコンテキスト（DC）を取得する関数
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

' デバイスコンテキスト（DC）を解放する関数
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long

' ディスプレイデバイスの各種機能を指す値（DPIなど）を取得する関数
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long


' --- ウィンドウ・座標取得 関連 API ---

' クラス名およびウィンドウ名（キャプション）からウィンドウハンドルを取得する関数
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
　　ByVal lpClassName As String, _
　　ByVal lpWindowName As String) As LongPtr

' 現在アクティブなウィンドウのハンドルを取得する関数
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr

' 指定されたウィンドウハンドルが実在・生存しているか確認する関数
Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long

' 指定ウィンドウのクライアント領域座標をスクリーン座標系に変換する関数
Private Declare PtrSafe Function ClientToScreen Lib "user32" ( _
　　ByVal hwnd As LongPtr, _
　　ByRef lpPoint As POINTAPI) As Long

' ウィンドウの境界矩形領域（スクリーン座標系）を取得する関数
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
　　ByVal hwnd As LongPtr, _
　　ByRef lpRect As RECT) As Long

' 指定されたウィンドウの表示状態（可視/不可視）を取得する関数
Private Declare PtrSafe Function IsWindowVisible Lib "user32" ( _
　　ByVal hwnd As LongPtr) As Long

' 指定されたウィンドウと特定のリレーション関係（親、所有者など）にあるウィンドウハンドルを取得する関数
Private Declare PtrSafe Function GetWindow Lib "user32" ( _
　　ByVal hwnd As LongPtr, _
　　ByVal wCmd As Long) As LongPtr

' 現在の呼び出し元スレッドのIDを取得する関数
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

' 指定されたスレッドIDに関連付けられている全ウィンドウを列挙する関数
Private Declare PtrSafe Function EnumThreadWindows Lib "user32" ( _
　　ByVal dwThreadId As Long, _
　　ByVal lpfn As LongPtr, _
　　ByVal lParam As LongPtr) As Long


' --- DPI座標変換 API ---

' フックから得られる物理ピクセル座標を、ウィンドウのDPI仮想化後の論理座標へ変換する関数（高DPI環境用）
Private Declare PtrSafe Function PhysicalToLogicalPointForPerMonitorDPI Lib "user32" ( _
　　ByVal hwnd As LongPtr, _
　　ByRef lpPoint As POINTAPI) As Long


'===============================================================================
'　定数定義
'===============================================================================

' --- フック識別定数 ---
Private Const WH_MOUSE_LL As Long = 14　　　　　' 低レベルマウスフックのフックタイプ識別子
Private Const WM_MOUSEWHEEL As Long = &H20A　　 ' マウスホイールの回転を感知するメッセージID
Private Const HC_ACTION As Long = 0　　　　　　 ' メッセージが正常に処理対象であることを示すフックコード

' --- DPI取得用定数 ---
Private Const LOGPIXELSX As Long = 88　　　　　 ' 画面の横方向の論理インチ当たりピクセル数（DPI）を取得するインデックス
Private Const LOGPIXELSY As Long = 90　　　　　 ' 画面の縦方向の論理インチ当たりピクセル数（DPI）を取得するインデックス

' --- ウィンドウ検索・スクロール調整用定数 ---
Private Const GW_OWNER As Long = 4　　　　　　　' GetWindow関数でオーナーウィンドウ（所有者）を取得するためのコマンド値
Private Const SCROLL_ROWS As Long = 3　　　　　 ' 1回のホイール回転でスクロールさせる行数（ListBox用）


'===============================================================================
'　構造体定義
'===============================================================================

' 画面上のX, Y座標（ピクセル単位）を格納する構造体
Private Type POINTAPI
　　X As Long　　　　　　　　　　　　　　　　　 ' X座標（水平位置）
　　Y As Long　　　　　　　　　　　　　　　　　 ' Y座標（垂直位置）
End Type

' 矩形領域の境界座標（ピクセル単位）を格納する構造体
Private Type RECT
　　Left As Long　　　　　　　　　　　　　　　　' 左端の座標
　　Top As Long　　　　　　　　　　　　　　　　 ' 上端の座標
　　Right As Long　　　　　　　　　　　　　　　 ' 右端の座標
　　Bottom As Long　　　　　　　　　　　　　　　' 下端の座標
End Type

' 低レベルマウスフック（WH_MOUSE_LL）から渡される詳細情報を格納する構造体
Private Type MSLLHOOKSTRUCT
　　pt As POINTAPI　　　　　　　　　　　　　　　' マウスカーソルの物理画面座標
　　mouseData As Long　　　　　　　　　　　　　 ' ホイール回転方向・移動量データ（上位16ビット）
　　flags As Long　　　　　　　　　　　　　　　 ' イベント発生フラグ
　　time As Long　　　　　　　　　　　　　　　　' タイムスタンプ
　　dwExtraInfo As LongPtr　　　　　　　　　　　' 拡張情報ポインタ
End Type


'===============================================================================
'　モジュール内変数定義
'===============================================================================

Private hHook As LongPtr　　　　　　　　　　　　' 設定したフックのハンドル
Private TargetControl As Object　　　　　　　　 ' スクロール制御対象のコントロール（ListBox / ComboBox）
Private IsProcessing As Boolean　　　　　　　　 ' 重複処理（再帰呼び出し）を防止するための処理中フラグ
Private PointsToPixelX As Double　　　　　　　　' ポイント(pt)からピクセル(px)への変換倍率（X方向）
Private PointsToPixelY As Double　　　　　　　　' ポイント(pt)からピクセル(px)への変換倍率（Y方向）

Private FoundDropdownHwnd As LongPtr　　　　　 ' 列挙処理時に検出されたドロップダウンリストのHWND
Private TargetFormHwnd As LongPtr　　　　　　　 ' 対象コントロールを保持する親UserFormのHWND


'===============================================================================
'　公開プロシージャ（外部からの開始・停止制御）
'===============================================================================

'-------------------------------------------------------------------------------
' プロシージャ名 : StartMouseHook
' 概要　　　　　 : 低レベルマウスフックを開始し、指定コントロールのスクロール制御を無効化・横取りします。
' 引数　　　　　 : ctrl (Object) - スクロール対象とするListBoxまたはComboBox
' 戻り値　　　　 : なし
'-------------------------------------------------------------------------------
Public Sub StartMouseHook(ByRef ctrl As Object)
　　' 制御対象のコントロールをセット
　　Set TargetControl = ctrl
　　
　　' DPIスケール情報が未初期化の場合は取得・計算を実行
　　If PointsToPixelX = 0 Then InitDpiScale
　　
　　' 親フォームの HWND をフック開始時に事前に特定・キャッシュ
　　Dim parentForm As Object
　　Set parentForm = GetParentForm(ctrl)
　　
　　If Not parentForm Is Nothing Then
　　　　' フォームのキャプション文字列からウィンドウハンドルを取得
　　　　If Len(parentForm.Caption) > 0 Then
　　　　　　TargetFormHwnd = FindWindow("ThunderDFrame", parentForm.Caption)
　　　　　　If TargetFormHwnd = 0 Then TargetFormHwnd = FindWindow("ThunderXFrame", parentForm.Caption)
　　　　End If
　　　　' キャプションから取得できなかった場合は現在アクティブなウィンドウを採用
　　　　If TargetFormHwnd = 0 Then TargetFormHwnd = GetActiveWindow()
　　End If
　　
　　' フックが未登録の場合のみOSにフックプロシージャを登録
　　If hHook = 0 Then
　　　　hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, 0&, 0&)
　　End If
End Sub

'-------------------------------------------------------------------------------
' プロシージャ名 : StopMouseHook
' 概要　　　　　 : 低レベルマウスフックを解除し、リソースおよび保持変数をクリアします。
' 引数　　　　　 : なし
' 戻り値　　　　 : なし
'-------------------------------------------------------------------------------
Public Sub StopMouseHook()
　　' フックが登録されている場合は解除を実施
　　If hHook <> 0 Then
　　　　UnhookWindowsHookEx hHook
　　　　hHook = 0
　　End If
　　
　　' モジュール内保持変数を初期化
　　Set TargetControl = Nothing
　　TargetFormHwnd = 0
　　IsProcessing = False
End Sub


'===============================================================================
'　フックコールバック & スクロール振り分け処理
'===============================================================================

'-------------------------------------------------------------------------------
' プロシージャ名 : MouseProc
' 概要　　　　　 : Windowsメッセージを監視し、対象コントロール上でのホイール操作を検知してスクロールを実行します。
' 引数　　　　　 : nCode (Long)　　- フックコード（HC_ACTION かどうか）
'　　　　　　　　　wParam (LongPtr) - WindowsメッセージID (WM_MOUSEWHEEL 等)
'　　　　　　　　　lParam (LongPtr) - MSLLHOOKSTRUCT構造体へのポインタ
' 戻り値　　　　 : LongPtr - 次のフックチェーンの戻り値
'-------------------------------------------------------------------------------
Public Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
　　' 万が一の例外発生時にフックチェーンが断絶しないよう、初期値として次のフック結果を確保
　　Dim nextHookResult As LongPtr
　　nextHookResult = CallNextHookEx(hHook, nCode, wParam, lParam)
　　
　　On Error GoTo SafeExit

　　' ホイール操作メッセージの検知チェック
　　If nCode = HC_ACTION And wParam = WM_MOUSEWHEEL Then
　　　　' 対象コントロールが存在しない、または処理中の場合はスルー
　　　　If TargetControl Is Nothing Or IsProcessing Then
　　　　　　MouseProc = nextHookResult
　　　　　　Exit Function
　　　　End If

　　　　' 安全ガード: 親フォームのウィンドウが破棄・閉鎖されている場合は自動解体
　　　　If TargetFormHwnd <> 0 Then
　　　　　　If IsWindow(TargetFormHwnd) = 0 Then
　　　　　　　　StopMouseHook
　　　　　　　　MouseProc = nextHookResult
　　　　　　　　Exit Function
　　　　　　End If
　　　　End If

　　　　' lParam からフック構造体データをコピーして取得
　　　　Dim hs As MSLLHOOKSTRUCT
　　　　CopyMemory hs, ByVal lParam, LenB(hs)

　　　　' フックから渡された物理ピクセル座標を論理座標系へ変換（高DPI対策）
　　　　Dim ptLogical As POINTAPI
　　　　ptLogical = hs.pt
　　　　If TargetFormHwnd <> 0 Then
　　　　　　PhysicalToLogicalPointForPerMonitorDPI TargetFormHwnd, ptLogical
　　　　End If

　　　　' マウスカーソルが対象コントロール（またはそのドロップダウン）の上にあるか判定
　　　　If IsCursorOverControl(TargetControl, ptLogical) Then
　　　　　　IsProcessing = True ' 二重処理防止フラグをオン
　　　　　　
　　　　　　' mouseDataの上位16ビットから回転方向と移動量を割り出し
　　　　　　Dim delta As Long
　　　　　　delta = CLng(hs.mouseData / &H10000)
　　　　　　
　　　　　　' コントロールの型に応じたスクロール処理の実行
　　　　　　If TypeOf TargetControl Is MSForms.ListBox Then
　　　　　　　　ScrollListBox TargetControl, delta
　　　　　　ElseIf TypeOf TargetControl Is MSForms.ComboBox Then
　　　　　　　　ScrollComboSelection TargetControl, delta
　　　　　　End If
　　　　　　
　　　　　　IsProcessing = False ' 処理完了に伴いフラグを解除
　　　　End If
　　End If

SafeExit:
　　MouseProc = nextHookResult
End Function


'===============================================================================
'　位置判定・ウィンドウ特定ヘルパー関数
'===============================================================================

'-------------------------------------------------------------------------------
' プロシージャ名 : IsCursorOverControl
' 概要　　　　　 : 指定したマウス座標が対象コントロール（またはドロップダウンリスト）内にあるか判定します。
' 引数　　　　　 : ctrl (Object)　　　 - 判定対象のコントロール
'　　　　　　　　　mousePt (POINTAPI) - 判定する論理画面座標
' 戻り値　　　　 : Boolean - コントロール範囲内の場合は True、範囲外なら False
'-------------------------------------------------------------------------------
Private Function IsCursorOverControl(ByRef ctrl As Object, ByRef mousePt As POINTAPI) As Boolean
　　On Error GoTo ErrHandler
　　
　　' 親フォームのHWNDが取得できていない場合は判定不能
　　If TargetFormHwnd = 0 Then
　　　　Exit Function
　　End If

　　' --------------------------------------------------------------------------
　　' パターン 1: ComboBox のドロップダウンリストが開いている場合の判定
　　' --------------------------------------------------------------------------
　　If TypeOf ctrl Is MSForms.ComboBox Then
　　　　Dim hwndComboList As LongPtr
　　　　hwndComboList = GetCurrentDropdownHwnd()
　　　　
　　　　' ドロップダウンウィンドウが検知できた場合、その領域内かをチェック
　　　　If hwndComboList <> 0 Then
　　　　　　Dim rcList As RECT
　　　　　　GetWindowRect hwndComboList, rcList
　　　　　　
　　　　　　If (mousePt.X >= rcList.Left And mousePt.X <= rcList.Right) And _
　　　　　　　 (mousePt.Y >= rcList.Top And mousePt.Y <= rcList.Bottom) Then
　　　　　　　　IsCursorOverControl = True
　　　　　　Else
　　　　　　　　IsCursorOverControl = False
　　　　　　End If
　　　　　　Exit Function
　　　　End If
　　End If
　　
　　' --------------------------------------------------------------------------
　　' パターン 2: 通常時（閉じたComboBox、または ListBox）の本体枠内判定
　　' --------------------------------------------------------------------------
　　Dim rcCtrl As RECT
　　If GetControlScreenRect(ctrl, rcCtrl) Then
　　　　' 端数計算による僅かな誤差を吸い込むマージン設定（8px）
　　　　Const MARGIN_PX As Long = 8
　　　　
　　　　' コントロールの表示範囲（マージン拡張含む）に座標が含まれるか評価
　　　　If (mousePt.X >= (rcCtrl.Left - MARGIN_PX) And mousePt.X <= (rcCtrl.Right + MARGIN_PX)) And _
　　　　　 (mousePt.Y >= (rcCtrl.Top - MARGIN_PX) And mousePt.Y <= (rcCtrl.Bottom + MARGIN_PX)) Then
　　　　　　IsCursorOverControl = True
　　　　　　Exit Function
　　　　End If
　　End If

　　IsCursorOverControl = False
　　Exit Function

ErrHandler:
　　IsCursorOverControl = False
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : GetCurrentDropdownHwnd
' 概要　　　　　 : 現在開いている ComboBox のドロップダウンリストウィンドウの HWND を取得します。
' 引数　　　　　 : なし
' 戻り値　　　　 : LongPtr - 検出されたドロップダウンリストの HWND（見つからない場合は 0）
'-------------------------------------------------------------------------------
Private Function GetCurrentDropdownHwnd() As LongPtr
　　FoundDropdownHwnd = 0
　　If TargetFormHwnd = 0 Then Exit Function
　　
　　Dim threadId As Long
　　threadId = GetCurrentThreadId()
　　
　　' 現在のGUIスレッドに属する全ウィンドウをスキャン
　　EnumThreadWindows threadId, AddressOf EnumThreadWndProc, 0&
　　GetCurrentDropdownHwnd = FoundDropdownHwnd
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : EnumThreadWndProc
' 概要　　　　　 : EnumThreadWindows コールバック。親フォームに所有されているポップアップリストを特定します。
' 引数　　　　　 : hwnd (LongPtr)　 - 検証中のウィンドウハンドル
'　　　　　　　　　lParam (LongPtr) - ユーザー定義パラメータ
' 戻り値　　　　 : Long - 列挙を継続する場合は 1、打ち切る場合は 0
'-------------------------------------------------------------------------------
Public Function EnumThreadWndProc(ByVal hwnd As LongPtr, ByVal lParam As LongPtr) As Long
　　' 可視状態のウィンドウのみをチェック対象とする
　　If IsWindowVisible(hwnd) <> 0 Then
　　　　' 親フォーム自身ではなく、かつオーナーが親フォームであるウィンドウを探す
　　　　If hwnd <> TargetFormHwnd Then
　　　　　　If GetWindow(hwnd, GW_OWNER) = TargetFormHwnd Then
　　　　　　　　Dim rc As RECT
　　　　　　　　GetWindowRect hwnd, rc
　　　　　　　　
　　　　　　　　' 面積を持った有効なポップアップリスト領域であれば検出確定
　　　　　　　　If (rc.Right - rc.Left > 0) And (rc.Bottom - rc.Top > 0) Then
　　　　　　　　　　FoundDropdownHwnd = hwnd
　　　　　　　　　　EnumThreadWndProc = 0 ' 目的のHWNDが見つかったため列挙終了
　　　　　　　　　　Exit Function
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　End If
　　EnumThreadWndProc = 1 ' 次のウィンドウ列挙へ継続
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : GetControlScreenRect
' 概要　　　　　 : コントロールのフォーム内オフセットを算出し、画面上のスクリーン領域（ピクセル単位）を取得します。
' 引数　　　　　 : ctrl (Object) - 対象コントロール
'　　　　　　　　　rcOut (RECT)　- 算出されたスクリーン矩形領域の格納用構造体
' 戻り値　　　　 : Boolean - 算出に成功した場合は True、失敗した場合は False
'-------------------------------------------------------------------------------
Private Function GetControlScreenRect(ByRef ctrl As Object, ByRef rcOut As RECT) As Boolean
　　If TargetFormHwnd = 0 Then Exit Function
　　
　　' フォーム左上原点からの相対位置(pt)を取得
　　Dim ctrlLeftPt As Double, ctrlTopPt As Double
　　If Not GetControlOffset(ctrl, ctrlLeftPt, ctrlTopPt) Then
　　　　GetControlScreenRect = False
　　　　Exit Function
　　End If
　　
　　' フォームのクライアント領域の左上座標（スクリーン座標px）を取得
　　Dim ptClient As POINTAPI
　　ptClient.X = 0
　　ptClient.Y = 0
　　ClientToScreen TargetFormHwnd, ptClient
　　
　　' ポイント単位をピクセル単位に変換して最終的なスクリーン座標を確定
　　Dim leftPx As Long, topPx As Long, widthPx As Long, heightPx As Long
　　leftPx = ptClient.X + CLng(ctrlLeftPt * PointsToPixelX)
　　topPx = ptClient.Y + CLng(ctrlTopPt * PointsToPixelY)
　　widthPx = CLng(ctrl.Width * PointsToPixelX)
　　heightPx = CLng(ctrl.Height * PointsToPixelY)
　　
　　' 戻り値の構造体を設定
　　rcOut.Left = leftPx
　　rcOut.Top = topPx
　　rcOut.Right = leftPx + widthPx
　　rcOut.Bottom = topPx + heightPx
　　
　　GetControlScreenRect = True
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : GetControlOffset
' 概要　　　　　 : コントロールがネスト配置（Frame/MultiPage等）されている場合でも、フォーム原点からの総オフセット位置(pt)を階層追跡して算出します。
' 引数　　　　　 : ctrl (Object)　　　- 対象コントロール
'　　　　　　　　　outLeft (Double)　 - 算出された左端からの累積オフセット(pt)
'　　　　　　　　　outTop (Double)　　- 算出された上端からの累積オフセット(pt)
' 戻り値　　　　 : Boolean - 累積計算が正常終了した場合は True、途中で非表示項目等があった場合は False
'-------------------------------------------------------------------------------
Private Function GetControlOffset(ByRef ctrl As Object, ByRef outLeft As Double, ByRef outTop As Double) As Boolean
　　Dim tempObj As Object
　　outLeft = 0
　　outTop = 0
　　Set tempObj = ctrl
　　
　　GetControlOffset = True
　　
　　' 階層を上位（Parent）へたどるループ処理
　　' Page / Frame / 始点コントロール自身である間、繰り返し親方向へ遡る
　　Do While (tempObj Is ctrl) Or TypeOf tempObj Is MSForms.Page Or TypeOf tempObj Is MSForms.Frame
　　　　
　　　　' 非表示（Visible = False）となっている要素が含まれる場合は無効とする
　　　　On Error Resume Next
　　　　If Not tempObj.Visible Then
　　　　　　GetControlOffset = False
　　　　　　Exit Function
　　　　End If
　　　　On Error GoTo 0

　　　　' --- 1. MultiPage 内の Page オブジェクトの処理 ---
　　　　If TypeOf tempObj Is MSForms.Page Then
　　　　　　Dim mp As MSForms.MultiPage
　　　　　　Dim pg As MSForms.Page
　　　　　　Set pg = tempObj
　　　　　　
　　　　　　' Pageから親MultiPageを再帰逆引き検索
　　　　　　Set mp = FindOwnerMultiPage(pg)
　　　　　　
　　　　　　If mp Is Nothing Then
　　　　　　　　GetControlOffset = False
　　　　　　　　Exit Function
　　　　　　End If
　　　　　　
　　　　　　' 現在アクティブなタブでない場合は処理対象外とする
　　　　　　If mp.Value <> pg.Index Then
　　　　　　　　GetControlOffset = False
　　　　　　　　Exit Function
　　　　　　End If
　　　　　　
　　　　　　' MultiPageの枠線およびタブ見出し高さを考慮したオフセットを加算
　　　　　　Const MP_TAB_HEADER_HEIGHT As Double = 18　 ' タブ見出し帯の近似高さ(pt)
　　　　　　Const MP_BORDER_MARGIN As Double = 2　　　　' 枠線部分の近似厚み(pt)
　　　　　　
　　　　　　outLeft = outLeft + mp.Left + MP_BORDER_MARGIN
　　　　　　outTop = outTop + mp.Top + MP_TAB_HEADER_HEIGHT
　　　　　　
　　　　　　Set tempObj = mp.Parent
　　　　　　If tempObj Is Nothing Then Exit Function
　　　　　　
　　　　' --- 2. Frame オブジェクトの処理 ---
　　　　ElseIf TypeOf tempObj Is MSForms.Frame Then
　　　　　　Dim fr As MSForms.Frame
　　　　　　Set fr = tempObj
　　　　　　
　　　　　　' Frameの枠線・内部領域(InsideWidth/Height)の差分をオフセットとして補正加算
　　　　　　outLeft = outLeft + fr.Left + ((fr.Width - fr.InsideWidth) / 2)
　　　　　　outTop = outTop + fr.Top + (fr.Height - fr.InsideHeight - 2)
　　　　　　
　　　　　　Set tempObj = tempObj.Parent
　　　　　　If tempObj Is Nothing Then Exit Function
　　　　　　
　　　　' --- 3. その他の通常コントロール（最初に渡されたctrl自身など） ---
　　　　Else
　　　　　　outLeft = outLeft + tempObj.Left
　　　　　　outTop = outTop + tempObj.Top
　　　　　　
　　　　　　Set tempObj = tempObj.Parent
　　　　　　If tempObj Is Nothing Then Exit Function
　　　　End If
　　Loop
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : FindOwnerMultiPage
' 概要　　　　　 : 指定した Page オブジェクトを保持している親 MultiPage を逆引き取得します。
' 引数　　　　　 : pg (MSForms.Page) - 所有者を検索したい Page オブジェクト
' 戻り値　　　　 : MSForms.MultiPage - 検出された MultiPage（見つからない場合は Nothing）
'-------------------------------------------------------------------------------
Private Function FindOwnerMultiPage(ByRef pg As MSForms.Page) As MSForms.MultiPage
　　Dim topForm As Object
　　Set topForm = GetParentForm(pg)
　　If topForm Is Nothing Then Exit Function
　　
　　' 最上位フォームからコントロール構造を再帰スキャンして探索
　　Set FindOwnerMultiPage = SearchMultiPageRecursive(topForm, pg)
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : SearchMultiPageRecursive
' 概要　　　　　 : 容器オブジェクト内のコントロール群を再帰的にスキャンし、指定 Page を所有する MultiPage を探します。
' 引数　　　　　 : container (Object) - 検索対象のコンテナ（UserForm / Frame / Page）
'　　　　　　　　　pg (MSForms.Page)　- 探している Page オブジェクト
' 戻り値　　　　 : MSForms.MultiPage　- 発見された MultiPage
'-------------------------------------------------------------------------------
Private Function SearchMultiPageRecursive(ByRef container As Object, ByRef pg As MSForms.Page) As MSForms.MultiPage
　　Dim c As Object
　　Dim i As Long
　　Dim found As MSForms.MultiPage
　　
　　For Each c In container.Controls
　　　　' MultiPageが配置されているかチェック
　　　　If TypeOf c Is MSForms.MultiPage Then
　　　　　　For i = 0 To c.Pages.Count - 1
　　　　　　　　' 探しているPageオブジェクトと一致した場合
　　　　　　　　If c.Pages(i) Is pg Then
　　　　　　　　　　Set SearchMultiPageRecursive = c
　　　　　　　　　　Exit Function
　　　　　　　　End If
　　　　　　　　' MultiPageがネスト配置（マルチページ内にさらにマルチページ）されている場合の再帰探索
　　　　　　　　Set found = SearchMultiPageRecursive(c.Pages(i), pg)
　　　　　　　　If Not found Is Nothing Then
　　　　　　　　　　Set SearchMultiPageRecursive = found
　　　　　　　　　　Exit Function
　　　　　　　　End If
　　　　　　Next i
　　　　' Frame内のネスト探索
　　　　ElseIf TypeOf c Is MSForms.Frame Then
　　　　　　Set found = SearchMultiPageRecursive(c, pg)
　　　　　　If Not found Is Nothing Then
　　　　　　　　Set SearchMultiPageRecursive = found
　　　　　　　　Exit Function
　　　　　　End If
　　　　End If
　　Next c
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : GetParentForm
' 概要　　　　　 : コントロール階層を上位にたどり、最上位にある UserForm を取得します。
' 引数　　　　　 : ctrl (Object) - 起点となるコントロール
' 戻り値　　　　 : Object　　　　- 検出された UserForm オブジェクト
'-------------------------------------------------------------------------------
Private Function GetParentForm(ByRef ctrl As Object) As Object
　　Dim tempObj As Object
　　Set tempObj = ctrl
　　
　　' コンテナ型（Page / Frame / MultiPage）および起点コントロール自身をたどる
　　Do While (tempObj Is ctrl) Or TypeOf tempObj Is MSForms.Page _
　　　　Or TypeOf tempObj Is MSForms.Frame Or TypeOf tempObj Is MSForms.MultiPage
　　　　
　　　　If tempObj.Parent Is Nothing Then Exit Function
　　　　Set tempObj = tempObj.Parent
　　Loop
　　
　　' ループ脱出時の最上位オブジェクト（UserForm）を返却
　　Set GetParentForm = tempObj
End Function

'-------------------------------------------------------------------------------
' プロシージャ名 : InitDpiScale
' 概要　　　　　 : 画面の DPI 情報（1ポイント当たりのピクセル数）を取得し、スケール変数を設定します。
' 引数　　　　　 : なし
' 戻り値　　　　 : なし
'-------------------------------------------------------------------------------
Private Sub InitDpiScale()
　　On Error Resume Next
　　Dim hdc As LongPtr
　　
　　' 全画面のデバイスコンテキスト（DC）を取得
　　hdc = GetDC(0&)
　　If hdc <> 0 Then
　　　　' 各軸方向の DPI 値からポイント→ピクセル換算比を計算 (96DPI = 1.333... px/pt)
　　　　PointsToPixelX = GetDeviceCaps(hdc, LOGPIXELSX) / 72#
　　　　PointsToPixelY = GetDeviceCaps(hdc, LOGPIXELSY) / 72#
　　　　ReleaseDC 0&, hdc
　　End If
　　
　　' APIからの取得に失敗した場合の標準フォールバック設定（100% DPI相当: 96/72）
　　If PointsToPixelX = 0 Then PointsToPixelX = 1.333333
　　If PointsToPixelY = 0 Then PointsToPixelY = 1.333333
End Sub


'===============================================================================
'　実際のスクロール移動処理
'===============================================================================

'-------------------------------------------------------------------------------
' プロシージャ名 : ScrollListBox
' 概要　　　　　 : ListBox に対するスクロール制御を実行（TopIndex を変更）します。
' 引数　　　　　 : lst (MSForms.ListBox) - 移動対象の ListBox
'　　　　　　　　　delta (Long)　　　　　- ホイール回転量・方向（正数で上スクロール、負数で下スクロール）
' 戻り値　　　　 : なし
'-------------------------------------------------------------------------------
Private Sub ScrollListBox(ByRef lst As MSForms.ListBox, ByVal delta As Long)
　　On Error Resume Next
　　With lst
　　　　' 上スクロール処理（回転量がプラス）
　　　　If delta > 0 Then
　　　　　　If .TopIndex >= SCROLL_ROWS Then
　　　　　　　　.TopIndex = .TopIndex - SCROLL_ROWS
　　　　　　Else
　　　　　　　　.TopIndex = 0
　　　　　　End If
　　　　' 下スクロール処理（回転量がマイナス）
　　　　ElseIf delta < 0 Then
　　　　　　If .ListCount > 0 Then
　　　　　　　　If .TopIndex + SCROLL_ROWS < .ListCount Then
　　　　　　　　　　.TopIndex = .TopIndex + SCROLL_ROWS
　　　　　　　　Else
　　　　　　　　　　.TopIndex = .ListCount - 1
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　End With
End Sub

'-------------------------------------------------------------------------------
' プロシージャ名 : ScrollComboSelection
' 概要　　　　　 : ComboBox に対する選択項目移動（ListIndex のインクリメント/デクリメント）を実行します。
' 引数　　　　　 : cb (MSForms.ComboBox) - 移動対象の ComboBox
'　　　　　　　　　delta (Long)　　　　　- ホイール回転量・方向（正数で前項目、負数で次項目）
' 戻り値　　　　 : なし
'-------------------------------------------------------------------------------
Private Sub ScrollComboSelection(ByRef cb As MSForms.ComboBox, ByVal delta As Long)
　　On Error Resume Next
　　With cb
　　　　' 上スクロール（前の要素を選択）
　　　　If delta > 0 Then
　　　　　　If .ListIndex > 0 Then .ListIndex = .ListIndex - 1
　　　　' 下スクロール（次の要素を選択）
　　　　ElseIf delta < 0 Then
　　　　　　If .ListIndex < .ListCount - 1 Then .ListIndex = .ListIndex + 1
　　　　End If
　　End With
End Sub


VBAコードの詳細解説

本モジュール（ModMouseWheel）は、複数のプロシージャが連携して「フックの登録・解除」「マウス位置の判定」「実際のスクロール処理」を行っています。
主要なプロシージャごとにその役割と仕組みを解説します。

StartMouseHook / StopMouseHook（フックの開始と解除）
役割: 低レベルマウスフックの登録と安全な解除を担当します。
仕組み: StartMouseHook では、監視対象のコントロールを保持した上で SetWindowsHookEx APIを呼び出し、OS全体のマウスイベントを監視するフックプロシージャ（MouseProc）を登録します。二重フックを防ぐため未登録時（hHook = 0）のみ実行します。フォーム終了時や非アクティブ化時には StopMouseHook から UnhookWindowsHookEx を呼び出し、リソースを確実に解放します。

MouseProc（マウスイベントの受取と制御）
役割: OSからマウス操作の通知を受け取るコールバック関数です。
仕組み: ホイール操作（WM_MOUSEWHEEL）を検知した際、CopyMemory APIを使ってマウスの画面座標と回転方向を取り出します。取得した物理ピクセル座標は PhysicalToLogicalPointForPerMonitorDPI により論理座標系へと変換し、高DPI環境での判定ズレを防ぎます。また、フォーム破棄時に IsWindow で生存確認を行って安全に自動解体する仕組みや、二重呼び出し防止フラグ（IsProcessing）を備え、フリーズやフック落ちを防ぎます。

IsCursorOverControl（マウス位置と有効領域の判定）
役割: マウスカーソルが対象コントロールの有効操作領域内にあるかを判定する判定の要となる関数です。
仕組み: ComboBox の判定時、まずドロップダウンリストが開いているかを調べます。リスト展開時は「展開されたドロップダウンリストの枠内」、閉じている時は「ComboBox 本体の枠内」というように、コンボボックスの状態に応じて当たり判定の対象領域を自動的に切り替え、僅かな誤差を吸収するマージン処理を含めて評価します。

GetCurrentDropdownHwnd / EnumThreadWndProc（ドロップダウンリストのHWND特定）
役割: ComboBox 展開時に生成されるポップアップウィンドウを正確に特定します。
仕組み: ドロップダウンはUserFormの子ウィンドウではなく、一時的に生成される別ウィンドウです。そのため通常の座標判定では検出できません。本モジュールでは EnumThreadWindows でスレッド内のウィンドウを順次チェックし、EnumThreadWndProc 内で GetWindow(hwnd, GW_OWNER) を使用して「親フォームが所有者（Owner）となっているポップアップ」のみを抽出することで、そのウィンドウだけを正確に特定しています。ドロップダウンが閉じている時はHWNDが「0」と判定されるため、画面外での誤動作や誤スクロールを完全に排除できます。

GetControlScreenRect / InitDpiScale / GetControlOffset（座標計算とDPI換算）
役割: VBA内部の論理単位（ポイント）を、画面上の絶対物理座標（ピクセル）へ精度高く変換します。
仕組み: InitDpiScale で画面のDPI解像度から換算係数を算出します。コントロールが Frame や MultiPage 内にネスト配置されている場合、GetControlOffset が親要素を遡り、Frameの枠線厚みやMultiPageのタブ見出し高さ（FindOwnerMultiPage や SearchMultiPageRecursive による再帰逆引き探索含む）を加算して絶対原点を算出します。これにDPI倍率を掛け合わせることで、どれほど複雑なフォーム構造や画面拡大率であっても寸分違わぬ領域判定を実現します。

ScrollListBox / ScrollComboSelection（スクロール・選択変更処理）
役割: 判定をクリアした際に、実際にコントロールの表示内容を動かします。
仕組み: ホイールの回転方向に応じて移動方向を決定します。ListBox では TopIndex を調整して指定行数（定数 SCROLL_ROWS）分スクロールさせ、ComboBox では ListIndex を前後に変更することで、直感的な操作感を実現しています。


使用しているWindows APIの解説

本モジュールでは、OSレベルのイベント取得、ウィンドウの特定、画面解像度の計算を行うために複数の Windows API を使用しています。それぞれの機能と本コードでの役割は以下の通りです。

マウスフック関連 API（OSレベルのイベント捕捉）
標準のVBAでは取得できない「マウスホイールの回転イベント」をOS全体から直接検知・制御するために使用します。
  • SetWindowsHookEx
    役割: 指定したフックプロシージャをOSのフックチェーン（イベント監視ライン）に登録します。
    用途: 低レベルマウスフック（WH_MOUSE_LL）を設置し、マウスホイールの回転通知をリアルタイムで受け取る仕組みを構築します。

  • UnhookWindowsHookEx
    役割: SetWindowsHookEx で登録したフックを解除します。
    用途: フォームが閉じた際や非アクティブ化時に呼び出し、不要になった監視処理を終了してリソースを安全に解放します。

  • CallNextHookEx
    役割: 捕捉したフックイベントを、次のフック処理（OSや他のアプリ）へ通過させます。
    用途: 自分の処理が終わった後、OSのマウス操作全般に影響を与えないようイベントを適切に次へ受け渡します。

  • CopyMemory (RtlMoveMemory)
    役割: メモリブロックのデータを別の変数（構造体）へ直接コピーします。
    用途: フックAPIからポインタ（メモリ領域のアドレス）として渡されるマウスイベント情報を、VBAで読み取れる構造体（MSLLHOOKSTRUCT）へデータ展開します。


ウィンドウ・ドロップダウン特定 API（正確な領域判定）
ドロップダウンはUserFormの子ウィンドウではなく一時的に生成される別ウィンドウであるため、通常の座標判定では検出できません。これらを特定し誤作動を防止するために使用します。
  • FindWindow
    役割: クラス名やウィンドウキャプション（タイトル）から、最前面にあるウィンドウのハンドル（HWND）を取得します。
    用途: 対象の UserForm のキャプションから、フォーム本体のウィンドウハンドルを特定します。

  • GetCurrentThreadId
    役割: 現在実行されているスレッドのIDを取得します。
    用途: 自プロセス（Excel/VBA）が生成したウィンドウのみを検索対象に絞り込むため、現在のスレッドIDを取得します。

  • EnumThreadWindows
    役割: 指定したスレッドが所有するすべてのウィンドウを順次列挙し、コールバック関数へ渡します。
    用途: ComboBox が開いた際に一時生成されるドロップダウンリストのウィンドウを探し出します。

  • GetWindow
    役割: 指定したウィンドウと特定の関係（親・子・所有者など）にある別のウィンドウハンドルを取得します。
    用途: 列挙されたウィンドウから GW_OWNER（所有者）フラグを用いて「UserFormが所有しているポップアップか」を判定し、ドロップダウンリスト領域をピンポイント特定します。

  • IsWindowVisible
    役割: 指定したウィンドウが現在画面上に表示（可視状態）されているかを判定します。
    用途: 非表示状態のゴーストウィンドウや非アクティブなリストを排除し、現在展開されているドロップダウンのみを判定対象とします。

DPI・座標計算関連 API（解像度ズレ防止）
VBA内部のポイント単位（pt）と、APIが扱うピクセル単位（px）のズレを解消し、画面上の絶対位置を正確に算出するために使用します。
  • ClientToScreen
    役割: ウィンドウ内のクライアント領域座標（フォーム原点 0,0）を、画面全体の絶対座標（ピクセル）に変換します。
    用途: UserForm が画面のどこに配置されているかを絶対ピクセル座標で割り出します。

  • GetWindowRect
    役割: 指定したウィンドウ全体の画面上の外形矩形（Left, Top, Right, Bottom）を取得します。
    用途: 特定した ComboBox ドロップダウンリストの描画エリア（四角形）をピクセル単位で取得します。

  • GetDC / ReleaseDC
    役割: 画面（ディスプレイ）のデバイスコンテキスト（DC）を取得および解放します。
    用途: 画面のグラフィック設定情報にアクセスするための準備・後始末を行います。

  • GetDeviceCaps
    役割: 指定したデバイスの各種能力値（解像度など）を取得します。
    用途: 画面の物理DPI（1インチあたりのピクセル数）を取得し、Windowsの「画面拡大率（125%や150%など）」に応じた1ポイントあたりの正確なピクセル換算係数を算出します。

  • PhysicalToLogicalPointForPerMonitorDPI
    役割: OSフックで取得された物理ピクセル座標を、高DPIモニターや仮想化されたウィンドウの「論理ピクセル座標」へ変換します。
    用途: Windowsの「高DPI設定（125%や150%など）」が有効なモニター上でマウスフック位置とフォーム位置の間に発生するズレを完全解消します。



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

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


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

ITエンジニアのための経理・会計・簿記入門｜エクセル雑感(2026-09-12)
「Python in Excel」入門：コードを読むための基礎知識｜エクセル関数応用(2026-09-10)
M言語入門：Power Queryのコードを読むための基礎知識｜Power Query（M言語）入門(2026-09-09)
Excelの正規表現関数（REGEXTEST・REGEXREPLACE・REGEXEXTRACT）の使い方｜エクセル関数応用(2026-09-08)
スピルとVBA（Formula2とスピル範囲の取得）｜VBA入門(2026-09-08)
「Withの功罪」：コードを読みやすくする強力な道具と、その落とし穴｜VBA技術解説(2026-09-03)
可変長配列をVSTACKする4つの方法｜REDUCE・Thunk・チャンク・再帰分割｜エクセル関数応用(2026-09-01)
Excel表とMarkdownテーブルを相互変換する数式｜エクセル関数応用(2026-08-24)
「Python in Excel」数独（ナンプレ）解法プログラムの移植と最適化｜エクセル関数応用(2026-08-14)
「Python in Excel」で自作関数を登録｜アンピボット関数と計算順序｜エクセル関数応用(2026-08-12)


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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.Excelショートカットキー一覧｜Excelリファレンス
5.RangeとCellsの使い方｜VBA入門
6.FILTER関数（範囲をフィルター処理）｜エクセル入門
7.マクロとは？VBAとは？VBAでできること｜VBA入門
8.繰り返し処理（For Next)｜VBA入門
9.メッセージボックス(MsgBox関数)｜VBA入門
10.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門



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


記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

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


↑