Problème pour désactiver l'évènement roulette de la souris

**willytito** · 03/03/2010, 17h45

Bonjour à toutes et à tous,

Je développe avec Access 2003 sous Windows XP pro.

J'ai trouvé le code suivant sur développez.com :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
  Un formulaire peut devenir pénible à utiliser car la molette de la souris fait défiler les enregistrements.
 
 
Cette solution fonctionne pour MS Access 2000 et 2003. (si vous avez testé pour d'autres versions n'hésitez pas à nous le faire savoir)
Il arrive cependant que l'erreur "nom ambigu détecté" se manifeste pour les version 2002 et ultérieures. Référez-vous dans ce cas au tutoriel dont le lien est en bas de cet article. 
 
 
1ere étape: 
 
 
Ouvrir un module VBA, aller dans Outils/Références, cliquer sur Parcourir et localiser la dll MouseWheel.dll puis cliquer sur Ouvrir. Cela permet d'enregistrer la dll dans les Références Access. 
 
 
2eme étape : 
 
 
Mettre le code suivant dans chaque formulaire qui requiert un contrôle de la roulette de la souris. 
   ' Déclaration dans chaque formulaire après Option Explicit et Option Compare Database
Private WithEvents clsMouseWheel As MouseWheel.CMouseWheel
 
 'Procédure à rajouter dans chaque formulaire
Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
    Cancel = True
End Sub
 
Private Sub Form_Load()
        'Code à rajouter dans l'événement chargement de chaque formulaire   
    Set clsMouseWheel = New MouseWheel.CMouseWheel
    Set clsMouseWheel.Form = Me
    clsMouseWheel.SubClassHookForm
End Sub
 
Private Sub Form_Close()
    'Code à rajouter dans l'événement fermeture de chaque formulaire
    If Not (clsMouseWheel Is Nothing) Then
        clsMouseWheel.SubClassUnHookForm
        Set clsMouseWheel.Form = Nothing
        Set clsMouseWheel = Nothing
    End If
End Sub

Au moment de le tester, sur l'évènement load() de mon formulaire, j'ai l'erreur suivant :

Erreur d'exécution '50002'
Erreur définier par l'application ou par l'objet.

J'ai vérifié mon code plusieurs fois.
Je ne vois pas l'erreur.
Si quelqu'un à une idée, je suis prenneur.

En fait mon but est de désactiver la molette de la souris sur mes formulaies.

Merci,
Willy

**willytito** · 09/03/2010, 16h02

Si le code précédent ne fonctionne pas.
J'ai testé le code suivant avec Access 2003 sous Windows XP Pro et ça fonctionne bien.
L'avantage un code unique pour tout le projet et possibilité d'activer et de désactiver l'évènement (mouseweel)

Dans un premier temps, il faut copier la DLL (MouseHook.dll) dans le répertoire du projet.

Puis coller le code suivant dans un module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Compare Database
Option Explicit
 
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
 
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
 
Private Declare Function StopMouseWheel Lib "MouseHook" _
(ByVal hWnd As Long, ByVal AccessThreadID As Long, _
Optional ByVal bNoSubformScroll As Boolean = False, Optional ByVal blIsGlobal As Boolean = False) As 
 
Boolean
 
Private Declare Function StartMouseWheel Lib "MouseHook" _
(ByVal hWnd As Long) As Boolean
 
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
 
' Instance returned from LoadLibrary call
Private hLib As Long
 
 
Public Function MouseWheelON() As Boolean
MouseWheelON = StartMouseWheel(Application.hWndAccessApp)
If hLib <> 0 Then
    hLib = FreeLibrary(hLib)
End If
End Function
 
Public Function MouseWheelOFF(Optional NoSubFormScroll As Boolean = False, Optional GlobalHook As 
 
Boolean = False) As Boolean
Dim s As String
Dim blRet As Boolean
Dim AccessThreadID As Long
 
On Error Resume Next
' Our error string
s = "Sorry...cannot find the MouseHook.dll file" & vbCrLf
s = s & "Please copy the MouseHook.dll file to your Windows System folder or into the same folder as 
 
this Access MDB."
 
' OK Try to load the DLL assuming it is in the Window System folder
hLib = LoadLibrary("MouseHook.dll")
If hLib = 0 Then
    ' See if the DLL is in the same folder as this MDB
    ' CurrentDB works with both A97 and A2K or higher
    hLib = LoadLibrary(CurrentDBDir() & "MouseHook.dll")
    If hLib = 0 Then
        MsgBox s, vbOKOnly, "MISSING MOUSEHOOK.dll FILE"
        MouseWheelOFF = False
        Exit Function
    End If
End If
 
' Get the ID for this thread
AccessThreadID = GetCurrentThreadId()
' Call our MouseHook function in the MouseHook dll.
' Please not the Optional GlobalHook BOOLEAN parameter
' Several developers asked for the MouseHook to be able to work with
' multiple instances of Access. In order to accomodate this request I
' have modified the function to allow the caller to
' specify a thread specific(this current instance of Access only) or
' a global(all applications) MouseWheel Hook.
' Only use the GlobalHook if you will be running multiple instances of Access!
MouseWheelOFF = StopMouseWheel(Application.hWndAccessApp, AccessThreadID, NoSubFormScroll, GlobalHook)
 
End Function
 
 
'******************** Code Begin ****************
'Code courtesy of
'Terry Kreft & Ken Getz
'
Function CurrentDBDir() As String
Dim strDBPath As String
Dim strDBFile As String
    strDBPath = CurrentDb.Name
    strDBFile = Dir(strDBPath)
    CurrentDBDir = Left$(strDBPath, Len(strDBPath) - Len(strDBFile))
End Function
'******************** Code End ****************