VBA 【64bit対応】ユーザーフォームをマウススクロールで上下させる方法

この記事は約7分で読めます。

【サムネイル】ユーザーフォームをマウススクロールで上下させる方法

どうも、マサヤです!

「ユーザーフォームってマウススクロールで上下できないの?」

「マウスホイールのイベント関数無いのだが・・・」

「標準機能として用意していないのは解った・・・でも、他のソフトとかで当たり前に出来ているマウススクロールが出来ないのって、ユーザーの求めている標準レベルにも到達できてないんじゃないの?」

 

最後は私が言われたことです)笑

正論なんだけど、決め打ちの短い工数で実装してほしいって無茶でしょ~私の気持ちも考えて・・・おっと、脱線しましたね。

この時は代替案で乗り切ったものの、まぁ悔しいわけです・・・そりゃーもう悔しい。

なので、調べまくって試行錯誤してようやく完成したコード。

「Excelのユーザーフォームはマウスホイールで上下スクロールできない問題」を解決するコードをご紹介します。

 

スポンサーリンク

事前に確認してほしいこと

 

本コードを参考にする上で事前に確認・注意してほしいことが3点あります。

  • 32bitで参考にする際は、コード変換必須。
  • モードレスには対応できていない。
  • フォーム終了は必ずイベント関数で。

 

32bitのPCで利用する際はコード変換が必要

本コードは64bit対応のため、32bitの場合はコードを変換して利用してください。

基本的には下記のように書き換えれば動くかと思いますが、32bitのPCで実際に確認できていません。

  • WindowsAPI宣言部分のPtrsafeを削除。
  • LongptrをLongに変換。

動かない場合は適時修正の上、利用してくださいね。

 

ユーザーフォームのモードレスには非対応

モーダル(フォームが表示中は裏に表示されているExcelが操作出来ないモード)利用では動きますが、モードレス(フォーム表示中も裏のExcel操作が可能)で利用はできません。

Excelがハングアップして固まり、強制終了することになるのでご注意ください。

 

フォーム終了は必ずイベント関数で終了処理を行う。

フォーム表示中はマウススクロールを検知するループ処理で走っているので、フォーム終了時に必ずループ処理を止める処理が必要となってきます。

本コードでは以下の部分が、終了処理に該当します。

'UserForm終了時にループを止める。
Private Sub UserForm_Terminate()
   '絶対に必要!VBEから強制終了させるとExcelが固まる。
   roopFlag = True
End Sub

 

終了処理を行わずにフォームを閉じた場合、ループ処理が止まらずExcelやPCへ継続的に負荷をかけることになり、PCが固まる可能性があるので必ず終了処理を実行してください。

また、フォームが終了するエラーが発生する可能性がある場合も例外処理で終了処理を挟むようにしてください。

 

スポンサーリンク

【コード】マウスホイールでフォーム内を上下スクロール

 

動画で実際の動きを確認してから、コードを紹介しますね。

コードは標準モジュールとユーザーフォームに分けて記載してます。

また、私自身も勉強中のため詳しい解説はしていません。

 

【動画】実際のスクロールの動きを確認

あなたが思っているスクロールと合っているか確認してみてください。

もし違う場合は本コードで解決できないので、ページをそっと閉じてください。

ユーザーフォームの上下スクロール

 

標準モジュールに記載するコード

標準モジュールに書き込むコードです。

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function TranslateMessage Lib "user32" (ByRef lpMsg As MSG) As Long
Declare PtrSafe Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (ByRef lpMsg As MSG) As Long
Declare PtrSafe Function GetMessage Lib "user32" Alias "GetMessageA" (ByRef lpMsg As MSG, ByVal hWnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long

Public Const WM_MOUSEWHEEL = &H20A

Type POINTAPI
        X As Long    'マウスカーソルのX座標(横)
        Y As Long    'マウスカーソルのY座標(縦)
End Type

Type MSG
     hWnd As LongPtr   'ウィンドウハンドル。
     message As Long   'メッセージID。
     wParam As LongPtr 'パラメータ。
     lParam As LongPtr 'パラメータ。
     time As Long      'メッセージ送信時間。
     pt As POINTAPI    'マウスカーソル座標。
End Type

 

ユーザーフォームに記載するコード

ユーザーフォームに書き込むコードです。

'ループフラグ
Public roopFlag As Long
Private Sub UserForm_Activate()
    Dim ms As MSG
    
    'UserFormのウィンドウハンドル取得
    hWnd = FindWindow("ThunderDFrame", Me.Caption)

    'メッセージループ
    Do Until roopFlag = True
    
        'ユーザフォームからのメッセージ(イベント)の取得
        Call GetMessage(ms, hWnd, 0, 0)
      
        'マウスホイール操作時
        If ms.message = WM_MOUSEWHEEL Then
            'パラメータの桁数が、7以上なら↓スクロール、以下なら上スクロールさせる
            If ms.wParam < 0 Then
                Me.ScrollTop = Me.ScrollTop + 20
            Else
                Me.ScrollTop = Me.ScrollTop - 20
            End If
        Else
            '必要ないイベントはウインドウプロシージャへ。
            TranslateMessage ms
            DispatchMessage ms
        End If
        
        DoEvents
    Loop
End Sub
'UserForm終了時にループを止める。
Private Sub UserForm_Terminate()
   '絶対に必要!VBEから強制終了させるとExcelが固まる。
   roopFlag = True
End Sub

 

まとめ

 

ユーザーフォームでマウスで上下スクロールさせるコードをご紹介しました。

縦長のフォームを作った際には重宝しますが、実装するかは注意点を考慮した上で検討してくださいね。

また、モードレスでも動くコードを書きたい所ですが、VBA上級編といった感じのWindowsAPIをもっと勉強する必要がありそうです。

作れたら共有しますね!

コメント