XL 2019 Molette Scroll sur ListBox

gg13

XLDnaute Occasionnel
Bonjour,

Je commence un nouveau projet pour lequel je devrai utiliser des ListBox et ComboBox.
Ces listes seront longues et je voudrais utiliser le scroll de la molette plutôt que les ascenseurs.

Après renseignement sur le site j’ai voulu utiliser ce post :
Mouse Wheel Hook (faire défiler le contenu d'une combobox/listbox avec la roulette)

Je galère depuis 2 jours et malgré plusieurs essais je n’arrive pas à intégrer ces différentes macros, plusieurs messages d’erreurs ….
Je ne comprends pas tout.
Si vous pouvez m’aider un peu je vous remercie d’avance.

Je joins le fichier exemple avec les listBox .

GG13
 

Pièces jointes

  • NBA1.3.xlsm
    37.6 KB · Affichages: 10

patricktoulon

XLDnaute Barbatruc
tiens @Dudu2 voici une petite demo qui t'aidera a comprendre comment je sais si je suis dans le child ou pas
c'est une ébauche là; il est nullement question de scroll pour le moment
tu va pouvoir constater que il n'y a pas besoins de comparer un rectangle à un autre qund on connais la classe

regarde
demo.gif
 

Pièces jointes

  • ebauche getrectangle handle.xlsm
    17.6 KB · Affichages: 3

Dudu2

XLDnaute Barbatruc
@patricktoulon,

Ta déclaration de WindowFromPoint est incorrect:
VB:
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As LongPtr, ByVal yPoint As LongPtr) As LongPtr
Il faut ça:
VB:
Declare PtrSafe Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr

HandleUF aussi:
VB:
HandleUF As Long
VB:
HandleUF As LongPtr

Et encore
VB:
Private Declare PtrSafe Function GetClassNameA Lib "user32" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Code:
Private Declare PtrSafe Function GetClassNameA Lib "user32" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Essaie de m'envoyer du code qui fonctionne, c'est pas agréable de devoir revisiter les déclarations de variables !
 

Dudu2

XLDnaute Barbatruc
Et donc c'est quoi le principe qui permet de savoir si on est sur la DropDown Window dans ce code ?
Code:
Function GetComborectangle(ByVal CtrL As Object)
    Dim pos As POINTAPI, ClassName As String, HandleControl As LongPtr, HandleParent As LongPtr, r As RECT
    ClassName = Space(255)
    GetCursorPos pos
    HandleControl = WindowFromPoint(pos.X, pos.Y)
    HandleParent = GetParent(HandleControl)
    GetClassNameA HandleParent, ClassName, 255
    GetComborectangle = GetWindowRect(HandleControl, r)
'pour la démo
UserForm1.TextBox1 = ClassName
UserForm1.TextBox2 = HandleParent
UserForm1.TextBox3 = HandleControl
End Function

Ne me laisse par jouer aux devinettes, c'est quoi ? Le ClassName qui est spécifique ? Autre chose ?
Déjà je me bats dans mes traces de Hook si il faut que je cherche dans ton Sudoku VBA j'y arrive pas ça me donne mal à la tête.
 

Dudu2

XLDnaute Barbatruc
Ce qui est sûr c'est que si en 32 bits, à partir du Curseur on peut récupérer la fenêtre de la ListBox ActiveX, en 64 bits on récupère que dalle à part la fenêtre parent c'est à dire Excel !

Et donc 2 problèmes majeurs:
  1. On ne peut que très difficilement écrire un code commun compatible 32/64 car les règles de comportement sont différentes. Ce n'est pas seulement une question de représentation 32/64 bits mais ça va bien au-delà. Pas très cool Excel !
    En plus, visiblement, le 64 bits 2016 se comporte différemment du 64 bits 365 !
    Il y a donc non pas 2, mais 3 environnements à rendre compatibles.

  2. Il faut trouver d'autres méthodes pour déterminer son RECT et ce n'est pas évident .
    Même si pour une ListBox ActiveX ça peut se faire facilement par ses coordonnées en points qu'on peut traduire en Pixels pour le RECT avec notre fameux Pan.PointsToScreenPixelsX / Y.
    Mais ça va être une autre histoire pour les ComboBoxes ActiveX et tout le bazar UserForm !
Quand je pense que j'ai mis 3 jours à faire un code qui tourne nickel sur 32 bits !
1667163625299.gif
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
et comment veux tu que je sache comment les déclarer je suis en 32

VB:
Function GetComborectangle(ByVal CtrL As Object)

    Dim pos As POINTAPI, ClassName As String, HandleControl As LongPtr, HandleParent As LongPtr, r As RECT

    'buffer string de 255 caractères
    ClassName = Space(255)

    'recup de position
    GetCursorPos pos

    'handle desous  le curseur
    HandleControl = WindowFromPoint(pos.X, pos.Y)


    'handleparent du handle sous le curseur
    HandleParent = GetParent(HandleControl)


    'recupération de la classe de fenetre du  handleparent dans la variable "classename"
    GetClassNameA HandleParent, ClassName, 255
    'normalement si la souris est dans le child la classe est "F3 MdcPopup XXXXXXXX"

    ' ca c'est sensé renvoyé le rect 'c'est pour plus tard
    GetComborectangle = GetWindowRect(HandleControl, r)


    'pour la démo
    ' incription des données dans les textbox du userform
    UserForm1.TextBox1 = ClassName

    UserForm1.TextBox2 = HandleParent

    UserForm1.TextBox3 = HandleControl

End Function
 

Dudu2

XLDnaute Barbatruc
Bonjour la Troupe des Scrolleurs,
@Staple1600,
Si j'étais moi, je regarderais plutôt là-dessous
Je pense que c'est la même chose qu'un gars a mis en Web Page.
Le nom de la page https://www.cadsharp.com/docs/Win32API_PtrSafe.txt est le nom du fichier dans le Download de Microsoft.

@patricktoulon,
Merci pour ton nouveau fichier. Pas d'erreur !
En fait, à part les plantages violents chez moi que j'essaie d'éviter, paradoxalement, le problème vient des ListBoxes pour lesquelles le GetWindowRect(WindowFromPoint) rend toujours n'importe quoi sur mon 64 bits 2016 alors que ça fonctionne en 365. Y a un foutu bug Excel.
Idem sur les plantages violents qui n'arrivent plus en 365.

En fait, dans la configuration que j'appelle "Crap", c'est à dire Win64 et pas Office 365 (mon cas donc), la Window récupérée dans une ListBox (ActiveX ou UserForm) est soit le haut + ruban de la fenêtre Excel si maximisée, soit n'importe quoi sinon.
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
te reste plus que setfocus et getfocus alors ça c'est universel
C'est une idée mais ça ne marchait pas tout le temps. Je pourrais ré-essayer.

Pour les ListBox, je détermine le RECT avec la recherche de la position.
Ça marche très bien pour ActiveX et pour les UserForm ma foi, c'est le problème des marges et je ne sais pas si le code que j'ai fait est universel mais chez moi c'est assez précis et comme il ne sera utilisé que pour le 64 Bits pas 365, je pense que les versions Office seront récentes.

Je fabrique un code compatible "32 et 64 365" d'une part et "64 non 365" d'autre part.
Je vais devoir vous le donner à tester !

Je n'ai pas réglé le problème des crash violents sur ma config. J'essaie de mettre des traces fichier parce qu'évidemment les traces Debug.Print sont perdues au crash.
 

Staple1600

XLDnaute Barbatruc
@Dudu2
C'est que tu n'as regardé ;)
Voici le bonus dont je parlais
Le document Word qui contient quelques conseils en plus
Bonus.png

En parlant de bonus, en voici un autre

Je vous laisse moleter en paix

Je vais acheter des bonbons
(Non, Mathilde n'est pas revenu ;)
Mais c'est ce foutu Halloween, et va falloir que je me coltine le défilé de la marmaille du voisinage
 
Dernière édition:

Statistiques des forums

Discussions
314 017
Messages
2 104 582
Membres
109 083
dernier inscrit
Stef06