Microsoft Access のみを使用して MouseWheel イベントを作成する
警告 : 可能な限り、この資料の「Visual Basic の ActiveX DLL を使用して MouseWheel イベントを作成する」に記載されている方法を使用するようにしてください。以下の方法を使用できるのは、Microsoft Access ランタイム アプリケーションなど、アプリケーションのユーザーが Microsoft Access 内で Visual Basic Editor を読み込まない場合に限られます。このソリューションを実装した場合に、ユーザーが Visual Basic Editor を開くと、以下のコードによって Microsoft Access が応答を停止します。また、Microsoft Access を起動している間に一度でも Visual Basic Editor を読み込んでいる場合は、このコードのテストを行う前に、Microsoft Access を再起動する必要があります。この方法を使用する場合には、作業内容を保存する頻度を高くし、データベースのバックアップを常に最新にしておくことを強く推奨します。

以下に例示するのは、カスタム クラス モジュールを使用して MouseWheel という名前のカスタム イベントを作成する方法です。これをフォームで使用することにより、ユーザーがマウスのホイールを回したことを検出できます。このカスタム イベントでは、Cancel 引数が公開されています。これにより、マウスのホイールが回転したことを示すメッセージが Microsoft Access によって受信されないようになり、フォーム内でレコードがスクロールされないようになります。

カスタム プロシージャを作成するには、次の手順を実行します。
注意 : この例の手順を実行すると、サンプル データベース Northwind.mdb が変更されます。Northwind.mdb ファイルのバックアップを作成し、そのデータベースのコピーに対してこれらの手順を実行することをお勧めします。

Microsoft Access を起動します。
サンプル データベース Northwind.mdb を開きます。
[挿入] メニューの [標準モジュール] をクリックして、Visual Basic Editor で新しいモジュールを作成します。
そのモジュールに次のコードを追加します。

Option Compare Database
Option Explicit

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

'Look at the message passed to the window. If it is
'a mouse wheel message, call the FireMouseWheel procedure
'in the CMouseWheel class, which in turn raises the MouseWheel
'event. If the Cancel argument in the form event procedure is
'set to False, then we process the message normally, otherwise
'we ignore it. If the message is something other than the mouse
'wheel, then process it normally
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

[ファイル] メニューの [projectの上書き保存] をクリックします。
モジュールを basSubClassWindow という名前で保存します。
[挿入] メニューの [クラス モジュール] をクリックします。
次のコードをクラス モジュールに追加します。

Option Compare Database
Option ExplicitPrivate frm As Access.Form
Private intCancel As Integer
Public Event MouseWheel(Cancel As Integer)

Public Property Set Form(frmIn As Access.Form)
'Define Property procedure for the class which
'allows us to set the Form object we are
'using with it. This property is set from the
'form class module.
Set frm = frmIn
End Property

Public Property Get MouseWheelCancel() As Integer
'Define Property procedure for the class which
'allows us to retrieve whether or not the Form
'event procedure canceled the MouseWheel event.
'This property is retrieved by the WindowProc
'function in the standard basSubClassWindow
'module.

MouseWheelCancel = intCancel
End Property

Public Sub SubClassHookForm()
'Called from the form's OnOpen or OnLoad
'event. This procedure is what "hooks" or
'subclasses the form window. If you hook the
'the form window, you must unhook it when completed
'or Access will crash.

lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
Set CMouse = Me
End Sub

Public Sub SubClassUnHookForm()
'Called from the form's OnClose event.
'This procedure must be called to unhook the
'form window if the SubClassHookForm procedure
'has previously been called. Otherwise, Access will
'crash.

Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Public Sub FireMouseWheel()

'Called from the WindowProc function in the
'basSubClassWindow module. Used to raise the
'MouseWheel event when the WindowProc function
'intercepts a mouse wheel message.
RaiseEvent MouseWheel(intCancel)
End Sub

[ファイル] メニューの [projectの上書き保存] をクリックします。
モジュールを CMouseWheel という名前で保存します。
デザイン ビューで [得意先] フォームを開きます。
[表示] メニューの [コード] をクリックしてフォームのクラス モジュールを表示します。
次のコードをフォームのクラス モジュールに追加します。

Option Compare Database
Option Explicit'Declare a module level variable as the custom class
'and give us access to the class's events
Private WithEvents clsMouseWheel As CMouseWheel

Private Sub Form_Load()
'Create a new instance of the class,
'and set the class's Form property to
'the current form
Set clsMouseWheel = New CMouseWheel
Set clsMouseWheel.Form = Me

'Subclass the current form by calling
'the SubClassHookForm method in the class
clsMouseWheel.SubClassHookForm
End Sub

Private Sub Form_Close()
'Unhook the form by calling the
'SubClassUnhook form method in the
'class, and then destroy the object
'variable

clsMouseWheel.SubClassUnHookForm
Set clsMouseWheel.Form = Nothing
Set clsMouseWheel = Nothing
End Sub

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
'This is the event procedure where you can
'decide what to do when the user rolls the mouse.
'If setting Cancel = True, we disable the mouse wheel
'in this form.

MsgBox "You cannot use the mouse wheel to scroll through records."
Cancel = True
End Sub

[ファイル] メニューの [終了して Microsoft Access へ戻る] をクリックします。
フォームを保存して閉じます。

注 : この時点では、フォームをフォーム ビューで開かないでください。開いた場合、Visual Basic Editor が読み込まれているため、Microsoft Access が応答を停止します。
Microsoft Access を終了します。
Microsoft Access を再起動し、サンプル データベース Northwind.mdb を開きます。
フォーム ビューで [得意先] フォームを開きます。
マウスのホイールを回します。
次のメッセージが表示されます。
You cannot use the mouse wheel to scroll through records.
また、現在のレコードが変わっていないことも確認してください。これは、マウスのホイールのメッセージが Microsoft Access によって処理されていないことを示します