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

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

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

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

えっ、標準機能として無いの・・・でも、他のソフトとかで当たり前にできるマウススクロールが出来ないのって、どうなの?

これ、私が言われたことです。正論なんだけど、決め打ちの短い工数で実装してほしいって無茶でしょ~私の気持ちも考えてくださいよ~・・・おっと、脱線しましたね。この時は代替案で乗り切ったんですが、まぁ悔しいわけです・・・そりゃーもう悔しい。

なので、調べまくって試行錯誤してようやく出来た「Excelのユーザーフォームはマウスホイールで上下スクロールできない問題」を解決するコードを共有しますね。

※100%動く訳ではないので、その際は色々試行錯誤してもらえればと思います。逆にコピペでOKといったレベルでは無いのでご了承ください。

スポンサーリンク

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

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

  • VBAバージョン6で実装する際は、コード変換必須
  • モードレスには対応してません
  • フォーム終了は必ずイベント関数を実行

VBAバージョン6以前のPCで利用する際はコード変換が必要

本コードはVBA7以降のコードですので、VBA6以前の場合は下記のようにコード変換をしてください。実際の動作確認は行っておりませんので、動かない場合は調べて修正いただければと思います。

  • 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
    Dim hWnd As LongPtr
    '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をもっと勉強する必要がありそうです。もし、作れたら共有しますね!

本記事が皆さんの役に少しでも立てば幸いです!

コメント

  1. 田中 格 より:

    とても素晴らしいです。利用させていただきます。
    なおhWndの定義が抜けているようです。
    あとスクロールバーのクリックによる移動でバーが黒くなる現象が生じるようです。
    マウススクロールをすると消えますが・・・

    • mMm より:

      田中さん
      利用いただけているとのことで、とても嬉しいです。
      hWnd定義抜けてましたね、追加しておきました!
      スクロールバーが黒くなりますね。解決法できる方法があるか探しておきますね。

  2. 田中 格 より:

    再度投稿します。
    別途テキストボックス内にカーソルがあるときにCtrl+;で日付を出力するようにするために
    下記の記述を使ったクラスを作成してイベントを取得できるようにしたら、マウスによるスクロールが旨く動かなくなりました。下スクロールしても上にいったり、終了させた場合に10秒程度は◎アイコンが出て固まったような状態になってしまいます。

    Private WithEvents txb1 As MSForms.textBox ‘イベントが発生するTextBox

    なお現象とは関係ないですが64ビット対応の記述について誤りがあると思います。
    基本的にPointerSafeとかLongPtrは32ビット版でも影響はないように自動的に元の記述にコンパイル時に変換されます。

    <間違った記述部分>
    ==========================================================
    32bitのPCで利用する際はコード変換が必要
    本コードは64bit対応のため、32bitの場合はコードを変換して利用してください。

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

    WindowsAPI宣言部分のPtrsafeを削除。
    LongptrをLongに変換。
    動かない場合は適時修正の上、利用してくださいね。
    ==========================================================
    <正しい記述は以下の部分に記述されています>

    VBA7以降のVBAでは64ビット対応の記述があっても基本的には問題ないことがわかります。
    (Office 2010 のリリース (VBA バージョン 6 以前) より前のVBAを使う場合だけ振り分けが必要になります)

    https://docs.microsoft.com/ja-jp/office/vba/language/concepts/getting-started/64-bit-visual-basic-for-applications-overview
    この問題に対処し、VBA コードが 32 ビットと 64 ビットの両方の環境で正しく動作できるようにするため、複数の言語機能が VBA に追加されています。 このドキュメントの下部にある表に、VBA の新しい言語機能を示します。 3 つの重要な追加機能は、LongPtr 型エイリアス、LongLong データ型、PtrSafe キーワードです。
    LongPtr。 VBA には変数型エイリアス LongPtr が追加されています。 LongPtr が解決される実際のデータ型は、実行している Office のバージョンによって決まります。32 ビット版の Office では LongPtr は Long に解決され、64 ビット版の Office では LongPtr は LongLong に解決されます。 LongPtr はポインターおよびハンドルに使用します。
    LongLong。 LongLong データ型は符号付きの 64 ビット整数であり、64 ビット版の Office でのみ使用できます。 LongLong は 64 ビット整数に使用します。 LongLong (64 ビットのプラットフォームの LongPtr を含む) をそれよりも小さい整数型に明示的に代入するには、変換関数を使用する必要があります。 LongLong をそれよりも小さい整数に暗黙的に変換することはできません。
    PtrSafe。 PtrSafe キーワードは、Declare ステートメントが 64 ビット版の Office で実行しても安全であることを示します。

    重要
    64 ビット版の Office で実行するときは、すべての Declare ステートメントに PtrSafe キーワードが含まれている必要があります。 PtrSafe キーワードを Declare ステートメントに追加しただけでは Declare ステートメントが 64 ビットを明示的に対象にしていることを示しているだけであると理解しておくことが重要です。 64 ビットを格納する必要があるステートメント内のすべてのデータ型 (戻り値とパラメーターを含む) を、64 ビットの大きさを保持するように変更する必要があります。

    注意

    PtrSafe キーワードを含む Declare ステートメントが推奨される構文です。 PtrSafe を含む Declare ステートメントは、32 ビットと 64 ビットの両方のプラットフォーム上の VBA7 開発環境で正常に動作します。
    VBA7 以前との下位互換性を保証するには、次の構造を使用してください。