Discussion :

[mercatog]

Bonjour!
Ayant appliqué le tutoriel Gestion de la roulette de la souris dans les formulaires (dll sans référencement) dans access 2003 présenté par M. Thierry GASPERMENT; j'ai la malchance de tomber sur un erreur "fatale" de l'application!
Est ce cela est dû à la version de mon access?
cordialement

[mercatog]

Une solution pour le partage:

insérez le module suivant:

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
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 ****************

Puis dans le formulaire en question, insérez ce code sur chargement:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Form_Load()
' Désactive la roulette de la souris
Dim blRet As Boolean
' Appelle la fonction MouseHook dans MouseHook.dll.
' Notez le paramètre Boolean optionel GlobalHook
' Plusieur developpeurs insiste sur le fait que la dll MouseHook serait capable de fonctionner
' avec des instances multiples d'Access. Pour répondre à leur requête
' j'ai modifié la fonction pour permettre aux utilisateurs de
' spécifier si les changements seront opérés seulement au niveau de l'instance Access en cours
' ou globalement pour toutes les applications MouseWheel Hook.
' Utilisez GlobalHook si vous désirez travailler avec des instances multiples d'Access!
    blRet = MouseWheelOFF(False)
 
End Sub

J'ai essayé de traduire!!
Mettez la dll suivante MouseHook.dll dans le dossier où l'application Access est placée ou dans le dossier System32 de Windows!
La dll ne nécessite aucun réferencement de registration! (pièces jointes).
La roulette sera désactivée dans tous les formulaires de l'application!
(par exemple, placez le code précédent une seule fois dans le formulaire de démarrage!)
Au cas où il faut réactiver la roulette, placez ce code dans l'évènement sur fermeture ou autre: (ci après, à la fermeture du formulaire, la roulette sera réactivée)

Code :

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

1
2
3
4
5
6
7
Private Sub Form_Close()
' Réactivela roulette de la souris
Dim blRet As Boolean
 
    blRet = MouseWheelON
 
End Sub

J'ai essayé cela sur Access 2003
Cordialement