Ajouter l'evenement scroll a un comboBox

[Fmiste]

Bonjour Le Forum,

J'ai un userform avec pas mal d'information rentrée , via ma base de données, qui concerne des profils d'aciers.

La liste est tellement longue que le cliqué glissé de la souris est vite ch*ant

Je voulais savoir s'il été possible d'ajouter l'évenement scroll de la souris afin de rendre la navigation dans mes comboBox plus agréable ?

Cordialement.

 

[Compte Supprimé 979]

Re : Ajouter l'evenement scroll a un comboBox

Bonjour Fmiste,

Il existe effectivement une solution pour récupérer le défilement de la roue
cela s'appelle le "hook" et est récupérable via une API windows

Si tu comprends un peu l'anglais
Cette partie est à mettre dans un module

Option Explicit

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const GWL_WNDPROC = -4
Private Const WM_MouseWheel = &H20A

 Private hWnd_UserForm As Long
Private lngWndProc As Long

'this traps the mousewheel scroll message as it's sent to your form by Wiindows,
'then it calls the procedure in the form's code module in order to scroll the list
Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MouseKeys As Long
Dim Rotation As Long

 If lMsg = WM_MouseWheel Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536

 'you will have to replace "UserForm1" in the following line, with the name of your form ;-)
UserForm1.ComboBox1_MouseWheel Rotation
End If
WindowProc = CallWindowProc(lngWndProc, lWnd, lMsg, wParam, lParam)

 End Function

Public Sub WheelHook(ClientForm As UserForm)
hWnd_UserForm = FindWindow("ThunderDFrame", ClientForm.Caption)
lngWndProc = SetWindowLong(hWnd_UserForm, GWL_WNDPROC, AddressOf WindowProc)
End Sub

 Public Sub WheelUnHook()
Dim lRet As Long
lRet = SetWindowLong(hWnd_UserForm, GWL_WNDPROC, lngWndProc)
End Sub

Cette partie si dans l'USF

'***************************************************
'Created by member Timbo @ xtremevbtalk.com
'Adapted from the ListBox solution by Mathieu Plante
'***************************************************

'#############################################################
'don't forget to substitute "ComboBox1" with your control name
'#############################################################

Option Explicit

 'flag to determine if the control is currently hooked
Private blnHooked As Boolean

 Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'create the hook when the mouse is over the control
ComboBox1_Hook
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'destroy the hook when the mouse is not over the control
ComboBox1_UnHook
End Sub

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'ensure the hook is destroyed before the form closes
ComboBox1_UnHook
End Sub

Private Sub UserForm_Deactivate()
'destroy the hook if another window takes the focus
ComboBox1_UnHook
End Sub

 Private Sub ComboBox1_Hook()
'only hook the control if it is not already hooked
If Not blnHooked Then
WheelHook Me
blnHooked = True
End If
End Sub

 Private Sub ComboBox1_UnHook()
'only destroy hook the control if it is already hooked
If blnHooked Then
WheelUnHook
blnHooked = False
End If
End Sub

'custom method to execute the mousewheel scroll action
Public Sub ComboBox1_MouseWheel(ByVal Rotation As Long)
Dim lngNewIndex As Long
Static intCounter As Integer

'a little retarding routine to make the mousewheel less sensitive!
intCounter = intCounter + 1
If Not intCounter = 3 Then Exit Sub
intCounter = 0

With Me.ComboBox1
If Rotation < 0 Then
lngNewIndex = .ListIndex + 1
If .ListCount > lngNewIndex Then .ListIndex = lngNewIndex
Else
If Not .ListIndex <= -1 Then .ListIndex = .ListIndex - 1
End If
End With
End Sub

A+

 

[Fmiste]

Re : Ajouter l'evenement scroll a un comboBox

Bonjour BrunoM45, merci de ta reponse.

En gros, il faut incorporer cela dans le code VBA de l'userform ?

 

[Compte Supprimé 979]

Re : Ajouter l'evenement scroll a un comboBox

Re,

J'ai modifié les indications de mon post
La première partie dans un module, la 2ème dans l'USF

Mais, après test ça n'a plus l'air de fonctionner !?

A voir de ton côté

A+

 

[Fmiste]

Re : Ajouter l'evenement scroll a un comboBox

Bonjour BrunoM45,

J'ai essayer d'integrer le code que tu m'a soumis comme indiqué.

Création de module pour le premiere partie et incorporation du second dans mon userform.

Mais celui ci me dit : Sub ou fonction non définie.

Je ne sais pas si c'était le cas pour toi.

 

[Compte Supprimé 979]

Re : Ajouter l'evenement scroll a un comboBox

Salut Fmiste,

Non l'affichage de mon USF fonctionne

Voici le fichier

A+

 

[Fmiste]

Re : Ajouter l'evenement scroll a un comboBox

Re,

Arf, moi ce n'est pas pareil, les informations de l'userform sont des éléments d'une base de données. Je ne sais donc pas ou inserer la partie module.

Sinon, c'est exactement ce qui ferait plaisir a mon patron

 

[Compte Supprimé 979]

Re : Ajouter l'evenement scroll a un comboBox

Salut Fmiste,

La provenance de tes données, n'a rien à voir avec ton problème de code ,

A+

 

[Fmiste]

Re : Ajouter l'evenement scroll a un comboBox

Salut BrunoM45,

arf, erreur de code donc ....

J'ai pourtant remplacé le nom "userform1" par le nom de mon userform et le nom "combobox1" par le nom de ma combobox a qui je souhaitais inserer l'evenement scroll.

La partie que je dois inserer dans un module, c'est le module de la feuille ou je dois creer un module a part ?

La partie a mettre dans l'userform, je la met a la suite de mon code ou je dois l'inserer dans une partie bien précise ?

Merci de tes réponses et de ta patience

 

[Compte Supprimé 979]

Re : Ajouter l'evenement scroll a un comboBox

Salut Fmiste,

Un module de feuille ça n'existe pas
Dans une feuille tu as des Sub (ou procédures)

Dans ton Projet VBA, quand tu fais insertion, tu as : UserFrom, Module et Module de classe

La partie USF est à mettre au début de la liste des tes sub

J'espère avoir été asse clair

A+

 

[Fmiste]

Re : Ajouter l'evenement scroll a un comboBox

Je me suis compris en gros

Mais le module que je crée pour inserer la premiere partie du code, je l'appelle dans mon code de l'userForm ou il est déja appelé dans le code fourni ?

EDIT : J'ai une erreur dès la premiere fonction, qui me dit : sub ou fonction non défini .

 

[Compte Supprimé 979]

Re : Ajouter l'evenement scroll a un comboBox

Re,

Cette partie est appelé par le code fourni pour l'USF

Private Sub ComboBox1_Hook() 'only hook the control if it is not already hooked
If Not blnHooked Then
WheelHook Me
blnHooked = True
End If
End Sub

Qui elle même est appelé par le code

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  'create the hook when the mouse is over the control
  ComboBox1_Hook
End Sub

Toujour dans l'USF

A+

 

[Fmiste]

Re : Ajouter l'evenement scroll a un comboBox

Re BrunoM45,

Après quelques modifications et grâce a ton exemple, j'ai réussi à faire fonctionner le code que tu m'a fourni.

Encore merci

 

[Compte Supprimé 979]

Re : Ajouter l'evenement scroll a un comboBox

Salut Fmiste

Fichtre ...

Tant mieux