Access:フォームでマウスのホイール操作を無効にして意図しないレコード移動を回避する方法

Accessのフォームでマウスのホイールを無効にするための設定手順について覚書。

Accessのフォームでデータを編集している時などにマウスのホイールを回してしまうと意図せず次のレコードに移動してしまったり、選択したコンボボックスの値が変わってしまったりしまいます。

特にレコードの編集中だとホイールによるレコード移動が発生すると編集中のレコードを更新されてしまいます。

マウスのホイール操作による意図しない動作を抑止するためにホイールによるレコード移動機能自体を無効にしてしまう方法についての覚書です。

この記事の目次

1 マウスホイールによるレコード移動の無効化方法について
- 1.1 Microsoftの技術情報
2 マウスホイールによるレコード移動の無効化方法

マウスホイールによるレコード移動の無効化方法について

Microsoftの技術情報にフォームでマウスホイールを無効にする方法がアップされていたのでこの記事でその方法をもう少し詳しく記述します。

この記事で紹介する方法は、Microsoftの技術情報で紹介されているVisual Basic の ActiveX DLL を使用する方法ではなく、Microsoft Access のみを使用してMouseWheelイベントを作成する方法について説明します。

Microsoftの技術情報

ACC2000: How to Detect and Prevent the Mouse Wheel from Scrolling Through Records in a Form

support.microsoft.com

マウスホイールによるレコード移動の無効化方法

これから紹介する方法を試す前に必ずデータベースファイルのバックアップを取っておいてください。

紹介する手順を間違った場合、最悪ハングアップ(実際にはハングアップではない)して強制終了しないとならなくなります。

以下にマウスホイールによるレコード移動の無効化する手順を記載します。

[ツール]メニューをクリックし、[マクロ]をポイントし、[Visual Basic Editor]をクリックする。

[Visual Basic Editor]画面が開くので、[挿入]メニューをクリックし、[クラスモジュール]をクリックする。

新規のクラスモジュール(class1)が開くので、以下のコードをコピーして貼り付ける。

Private frm As Access.Form
Private intCancel As Integer
Public Event MouseWheel(Cancel As Integer)
Public Property Set Form(frmIn As Access.Form)
Set frm = frmIn
End Property
Public Property Get MouseWheelCancel() As Integer
MouseWheelCancel = intCancel
End Property
Public Sub SubClassHookForm()
lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC,AddressOf WindowProc)
Set CMouse = Me
End Sub
Public Sub SubClassUnHookForm()
Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Public Sub FireMouseWheel()
RaiseEvent MouseWheel(intCancel)
End Sub

Private frm As Access.Form

Private intCancel As Integer

Public Event MouseWheel(Cancel As Integer)

Public Property Set Form(frmIn As Access.Form)

Set frm = frmIn

End Property

Public Property Get MouseWheelCancel() As Integer

MouseWheelCancel = intCancel

End Property

Public Sub SubClassHookForm()

lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC,AddressOf WindowProc)

Set CMouse = Me

End Sub

Public Sub SubClassUnHookForm()

Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)

End Sub

Public Sub FireMouseWheel()

RaiseEvent MouseWheel(intCancel)

End Sub

貼り付けたら[ファイル]メニューの[XXXの上書き保存](XXXは、データベース名)をクリックし、クラスモジュールを保存する。

この際以下のようなクラスモジュール名を入力する[名前を付けて保存]ダイアログボックスが表示されるので「CMouseWheel」と入力して[OK]ボタンをクリックする。

次に[挿入]メニューをクリックし、[標準モジュール]をクリックする。

新規の標準モジュール(Module1)が開くので、以下のコードを貼り付ける。

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
     
Public Const GWL_WNDPROC = -4
Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long
Public CMouse As CMouseWheel
Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
  Case WM_MouseWheel
CMouse.FireMouseWheel
      If CMouse.MouseWheelCancel = False Then
    WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
  End If
           
  Case Else
  WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Select
End Function

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _

(ByVal hwnd As Long, _

ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _

(ByVal lpPrevWndFunc As Long, _

ByVal hwnd As Long, _

ByVal msg As Long, _

ByVal wParam As Long, _

ByVal lParam As Long) As Long

Public Const GWL_WNDPROC = -4

Public Const WM_MouseWheel = &H20A

Public lpPrevWndProc As Long

Public CMouse As CMouseWheel

Public Function WindowProc(ByVal hwnd As Long, _

ByVal uMsg As Long, _

ByVal wParam As Long, _

ByVal lParam As Long) As Long

Select Case uMsg

Case WM_MouseWheel

CMouse.FireMouseWheel

If CMouse.MouseWheelCancel = False Then

WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)

End If

Case Else

WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)

End Select

End Function

貼り付けたら[ファイル]メニューの[XXXの上書き保存](XXXは、データベース名)をクリックし、標準モジュールを保存する。

この際以下のような標準モジュール名を入力する[名前を付けて保存]ダイアログボックスが表示されるので「basSubClassWindow」と入力して[OK]ボタンをクリックする。

次にマウスのホイールを無効にしたいフォームをデザインで開く。 (例としてAccessに付属されているサンプルデータベース”Northwind.mdb”の[商品リスト]フォームを使用)

[商品リスト]フォームがアクティブになっている状態でメニューバーの[表示]を選択し、[コード]をクリックする。

[商品リスト]フォームのコード画面が開くので以下のコードを貼り付ける。

Private WithEvents clsMouseWheel As CMouseWheel
Private Sub Form_Load()
Set clsMouseWheel = New CMouseWheel
Set clsMouseWheel.Form = Me
clsMouseWheel.SubClassHookForm
End Sub
Private Sub Form_Close()
clsMouseWheel.SubClassUnHookForm
Set clsMouseWheel.Form = Nothing
Set clsMouseWheel = Nothing
End Sub
Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
'マウスのホイールが無効になっていることをメッセージボックスで表示したい場合は
'以下の行のコメントアウトを外す
'MsgBox "マウスホイールは無効です。"
Cancel = True
End Sub

Private WithEvents clsMouseWheel As CMouseWheel

Private Sub Form_Load()

Set clsMouseWheel = New CMouseWheel

Set clsMouseWheel.Form = Me

clsMouseWheel.SubClassHookForm

End Sub

Private Sub Form_Close()

clsMouseWheel.SubClassUnHookForm

Set clsMouseWheel.Form = Nothing

Set clsMouseWheel = Nothing

End Sub

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)

'マウスのホイールが無効になっていることをメッセージボックスで表示したい場合は

'以下の行のコメントアウトを外す

'MsgBox "マウスホイールは無効です。"

Cancel = True

End Sub

フォームを上書き保存して閉じる。

注意：ここでフォームをフォームビューで開かないこと！

Accessを終了する。

Accessを再度起動し、[商品リスト]フォームのマウスホイール操作が無効になっていることを確認してください。