Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Daniel AUBRY
Bonjour,
perso, j'utilise ceci avec bonheur depuis pas mal de temps : (ce code n'est pas de moi, j'ai du le trouver sur vbFrance)
A placer dans un module : 'Gestion de la roulette de la souris dans MsFlexGrid Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
Private Type POINTAPI X As Long Y As Long End Type
Private Type POINT X As Integer Y As Integer End Type
Private Type MSLLHOOKSTRUCT pt As POINT mouseData As Integer flags As Integer Time As Integer dwExtraInfo As Integer End Type
Private Const WM_MOUSEWHEEL As Long = &H20A Private Const WH_MOUSE_LL = 14 Private Const WM_VSCROLL As Integer = &H115
Private Const SB_LINEDOWN As Integer = 1 Private Const SB_LINEUP As Integer = 0 Private Const SB_ENDSCROLL As Integer = 8
Dim lHwndHook As Long
Public Sub InstalleHook() lHwndHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookMouseProc, App.hInstance, 0) End Sub
Public Sub DesinstalleHook() If lHwndHook Then UnhookWindowsHookEx (lHwndHook) lHwndHook = 0 End Sub
A placer dans le Form_Initialize du formulaire de démarrage If App.LogMode <> 0 Then InstalleHook--
A placer dans le Form_QueryUnload de la même feuille If App.LogMode <> 0 Then DesinstalleHook
App.LogMode sert à ne pas l'utiliser dans le mode IDE car si tu plantes, tu n'as plus de souris !!!!
Dany
"Salva" a écrit dans le message de news:
Bonjour a tous,
J'aimerais pouvoir utiliser la souris dans mon MsHFlexGrid, faire défiler comme dans Excel
Comment faire?
Merci de votre aide
Salva
Bonjour,
perso, j'utilise ceci avec bonheur depuis pas mal de temps :
(ce code n'est pas de moi, j'ai du le trouver sur vbFrance)
A placer dans un module :
'Gestion de la roulette de la souris dans MsFlexGrid
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA"
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long,
ByVal yPoint As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As
Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long,
ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As
Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As
Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long,
lpRect As RECT) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type POINT
X As Integer
Y As Integer
End Type
Private Type MSLLHOOKSTRUCT
pt As POINT
mouseData As Integer
flags As Integer
Time As Integer
dwExtraInfo As Integer
End Type
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WH_MOUSE_LL = 14
Private Const WM_VSCROLL As Integer = &H115
Private Const SB_LINEDOWN As Integer = 1
Private Const SB_LINEUP As Integer = 0
Private Const SB_ENDSCROLL As Integer = 8
Dim lHwndHook As Long
Public Sub InstalleHook()
lHwndHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookMouseProc,
App.hInstance, 0)
End Sub
Public Sub DesinstalleHook()
If lHwndHook Then UnhookWindowsHookEx (lHwndHook)
lHwndHook = 0
End Sub
A placer dans le Form_Initialize du formulaire de démarrage
If App.LogMode <> 0 Then InstalleHook--
A placer dans le Form_QueryUnload de la même feuille
If App.LogMode <> 0 Then DesinstalleHook
App.LogMode sert à ne pas l'utiliser dans le mode IDE car si tu plantes, tu
n'as plus de souris !!!!
Dany
"Salva" <hotmerlino@hotmail.com> a écrit dans le message de news:
070B1257-2B2E-4C19-9538-6872069FF04F@microsoft.com...
Bonjour a tous,
J'aimerais pouvoir utiliser la souris dans mon MsHFlexGrid, faire défiler
comme dans Excel
perso, j'utilise ceci avec bonheur depuis pas mal de temps : (ce code n'est pas de moi, j'ai du le trouver sur vbFrance)
A placer dans un module : 'Gestion de la roulette de la souris dans MsFlexGrid Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
Private Type POINTAPI X As Long Y As Long End Type
Private Type POINT X As Integer Y As Integer End Type
Private Type MSLLHOOKSTRUCT pt As POINT mouseData As Integer flags As Integer Time As Integer dwExtraInfo As Integer End Type
Private Const WM_MOUSEWHEEL As Long = &H20A Private Const WH_MOUSE_LL = 14 Private Const WM_VSCROLL As Integer = &H115
Private Const SB_LINEDOWN As Integer = 1 Private Const SB_LINEUP As Integer = 0 Private Const SB_ENDSCROLL As Integer = 8
Dim lHwndHook As Long
Public Sub InstalleHook() lHwndHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookMouseProc, App.hInstance, 0) End Sub
Public Sub DesinstalleHook() If lHwndHook Then UnhookWindowsHookEx (lHwndHook) lHwndHook = 0 End Sub
A placer dans le Form_Initialize du formulaire de démarrage If App.LogMode <> 0 Then InstalleHook--
A placer dans le Form_QueryUnload de la même feuille If App.LogMode <> 0 Then DesinstalleHook
App.LogMode sert à ne pas l'utiliser dans le mode IDE car si tu plantes, tu n'as plus de souris !!!!
Dany
"Salva" a écrit dans le message de news:
Bonjour a tous,
J'aimerais pouvoir utiliser la souris dans mon MsHFlexGrid, faire défiler comme dans Excel
Comment faire?
Merci de votre aide
Salva
Salva
Bonjour,
Merci pour votre réponse c'est exactement ce que je cherchais.
A bientôt
Salva
Bonjour,
Merci pour votre réponse c'est exactement ce que je cherchais.