XL 2021 VBA - Est-ce que la ListBox a une Scroll Barre Verticale ?

[Dudu2]

Bonjour,

Comment déterminer, à part avec une approximation pas forcément juste sur la Font.Size comme dans l'exemple joint, si une ListBox as une Scroll Barre Verticale ?

 

[jcf6464]

Bonjour,

Comment déterminer, à part avec une approximation pas forcément juste sur la Font.Size comme dans l'exemple joint, si une ListBox as une Scroll Barre Verticale ?

Bonjour Dudu2 et le forum,

regarde

http://www.excel-downloads.com/forum/184564-mouse-wheel-hook-faire-defiler-le-contenu-dune-combobox-listbox-avec-la-roulette.html#post1140294

bonne continuation jcf

 

[sylvanu]

Bonjour Dudu, Jcf,
N'ayant pas la réponse, je me suis amusé à poser la question à quelques IA ( ChatGPT, Aria, Mistral ) et les 3 donne la même approche, mais sur mon vieux 2007 ça ne marche pas. Ils font tous appel à ListObject.ListRows. En faisant :

Function ListBoxHasVerticalScrollBar(lb As MSForms.ListBox) As Boolean
    ' Vérifie si le nombre d'éléments est supérieur au nombre d'éléments visibles
    ListBoxHasVerticalScrollBar = (lb.ListCount > lb.ListRows)
End Function

A tester puisque cette fonction existe surement sur les XL plus récent. ( Lien )

 

[Dudu2]

Merci @jcf6464, mais ton lien n'aboutit pas. De toutes façons ce n'est pas une question de Scroll souris.
Merci @sylvanu, mais il me semble que cette propriété (.ListRows) s'applique aux ComboBox mais pas aux ListBox.
Il va peut-être falloir y aller par API pour savoir si la Window a une Vertical ScrollBar.

 

[Dudu2]

Pas de résultat avec l'API GetWindowLong(hWnd, GWL_STYLE) and WS_VSCROLL.

 

[Rheeem]

Pour savoir si une listbox contient scrollbar deux possibilités sont envisageable avec IAccessible
1) récupérer les coordonnés de la listbox ainsi celles du dernier élément et vérifier si la bordure inférieure de l'élément ne dépasse pas le cadre de la liste

2) faire un hit-test dans la listbox dans la lucarne haute-droite si un élément est envoyé cela signifie que la liste ne contient pas un scrollbar

 

[Dudu2]

@Rheeem,
Je ne sais pas récupérer les coordonnées du dernier élément de la liste.
Je ne comprends pas "si un élément est envoyé". S'il s'agit de récupérer l'évènement Change, ça ne me convient pas car je ne peux pas dans le contexte où je fais ça.

J'ai bien pensé à cliquer dans la ListBox et envoyer la touche FIN/END et voir si le .TopIndex a bougé mais si ça marche pour ListBox1 et ListBox3, ça ne marche pas pour ListBox2.

 

[Rheeem]

Je ne comprends pas "si un élément est envoyé".
Le but est de récupérer l'élément en haute de la liste sous le point à l’extimité droite si le bouton up du srollbar est présent donc le histest renvoie 0 sinon elle renvoie TopIndex toujours positif .. le problème la listebox sur le classeur ne fonctionne pas correctement les coordonnées sont touts à 0 donc ca nécessite davantage de recherche pour le faire fonctionner ..
une alternative c'est d'utiliser AccessibleObjectFromPoint au lieu de hitTest:

#If Win64 Then
   Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal arg1 As LongPtr, ppacc As IAccessible, pvarChild As Variant) As Long
#Else
   Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
#End If

Private Function HasSb(ByVal Lb As MSForms.ListBox) As Boolean
Dim ac As IAccessible, cc As IAccessible
Dim p(0 To 3) As Long, pz As Long, v As Variant
If Lb.ListCount = 0 Then Exit Function
Set ac = Lb
ac.accLocation p(0), p(1), p(2), p(3), Lb.TopIndex
pz = p(0) + p(2) - 5
AccessibleObjectFromPoint pz, p(1) + 5, cc, v
HasSb = v <> 0
End Function

 

[Dudu2]

Les coordonnée de la ListBox peuvent être trouvées de différentes façons:

1. LeftPixel = ActiveWindow.Panes(1).PointsToScreenPixelsX(ListBox.Left)
   TopPixel = ActiveWindow.Panes(1).PointsToScreenPixelsY(ListBox.Top)
   RightPixel = ActiveWindow.Panes(1).PointsToScreenPixelsX(ListBox.Left + ListBox.Width)
   BottomPixel = ActiveWindow.Panes(1).PointsToScreenPixelsY(ListBox.Top + ListBox.Height)
   
   
2. WindowFromAccessibleObject(ListBox, hWnd)
   R = GetWindowRect(hWnd)
   
   
3. hWnd = WindowFromPoint sur LeftPixel + 2 et TopPixel + 2
   R = GetWindowRect(hWnd)
   (Redondant avec la 1ère option)

La plus simple étant la 2ème.

Je ne comprends toujours pas en quoi l'AccessibleObjectFromPoint() te permet de faire la différence.
Qu'espères-tu récupérer avec cette API en haut à droite de la ListBox:
- dans le cas d'une Scroll Bar ?
- dans le cas d'un Item de liste ?

Le problème avec les ListBox c'est que la ScrollBar fait partie de la ListBox. C'est le même objet et sa largeur n'est pas ajoutée à la largeur de la ListBox.
Si ta solution ne donne pas de résultat, j'irai tester la couleur sous le curseur au milieu à droite.

Edit: ou alors peut-être une solution simple sur la sélection du 1er Item.
Sauvegarder le .TopIndex.
Sauvegarder état de sélection de l'Item .TopIndex
Sauvegarder l'item selectionné si .MultiSelect = False
Sauvegarder la position du curseur.
Désélectionner l'Item .TopIndex s'il est sélectionné
Cliquer en haut à droite (mouse_event en ListBox Right - SM_CXVSCROLL / 2 et ListBox Top + SM_CXVSCROLL / 2)
Si le l'Item .TopIndex initial est sélectionné => pas de Scroll Bar
Sinon => Scroll Bar
Remettre le .TopIndex à sa valeur initiale.
Remettre le l'Item .TopIndex dans son état de sélection initial.
Sélectionner l'item initialement selectionné si .MultiSelect = False
Remettre le curseur où il était.

 

[TooFatBoy]

Hello 😉

Merci @jcf6464, mais ton lien n'aboutit pas.

Ca doit être ça :

C

Discussion 'Mouse Wheel Hook (faire défiler le contenu d'une combobox/listbox avec la roulette)'

16 Mai 2012

Bonjour à tous,

Suite à la demande de Fmiste concernant la possibilité de faire défiler le contenu d'une ComboBox

Je me suis aperçu qu'il n'y avait pas tellement de fil traitant ce sujet sur le forum 🙁
ou du moins je n'en ai pas trouvé concernant le terme "Mouse wheel"

Je mets donc ici à disposition, le classeur avec le code qui va bien 😱

Cela pourra toujours servir à quelqu'un

Au plaisir

• Compte Supprimé 979

• 

 

[Dudu2]

Merci @TooFatBoy, cependant il ne s'agit pas de scroller la ListBox avec la Souris.
Pour ça j'ai pas moins de 3 solutions différentes qui fonctionnent toutes 😛.

Il s'agit de savoir si la ListBox possède une barre de Scroll verticale.
La seule solution qui devrait marcher c'est le GetWindowLong(GWL_STYLE) mais le test sur le bit WS_VSCROLL ne donne rien.
D'où la recherche d'une bidouille pour trouver le résultat, et je pense avoir une bonne option avec mon commentaire précédent.

 

[TooFatBoy]

Salut Dudu 😉

Oui, j'avais bien vu ta remarque :

De toutes façons ce n'est pas une question de Scroll souris.

Mais je mettais tout de même le lien juste pour que jcf6464 dise si c'était bien celui-là qu'il voulait mettre.


Bonne nuit, camarade
🖖

 

[jurassic pork]

Pour savoir si une listbox contient scrollbar deux possibilités sont envisageable avec IAccessible
1) récupérer les coordonnés de la listbox ainsi celles du dernier élément et vérifier si la bordure inférieure de l'élément ne dépasse pas le cadre de la liste

Hello,
excellente idée et en plus on peut le faire facilement avec UIAutomation. Voici le code :

Sub TestSB_ListBox()
Dim OAcc As IAccessible, c As New CUIAutomation, rect As tagRECT
Set OAcc = Feuil1.ListBox1
Debug.Print "ScrollBar ListBox1 visible ?  ", SBV_visible(c, OAcc)
Set OAcc = Feuil1.ListBox2
Debug.Print "ScrollBar ListBox2 visible ?  ", SBV_visible(c, OAcc)
Set OAcc = Feuil1.ListBox3
Debug.Print "ScrollBar ListBox3 visible ?  ", SBV_visible(c, OAcc)
End Sub
Function SBV_visible(c As CUIAutomation, objAcc As IAccessible) As Boolean
Dim UIA_elem As IUIAutomationElement, rect As tagRECT
Set UIA_elem = c.ElementFromIAccessible(objAcc, 0)
rect = UIA_elem.CurrentBoundingRectangle
Debug.Print rect.bottom
Set UIA_elem = c.ElementFromIAccessible(objAcc, objAcc.accChildCount)
rect = UIA_elem.CurrentBoundingRectangle
Debug.Print rect.bottom
If rect.bottom = 0 Then SBV_visible = True Else SBV_visible = False
End Function

Le dernier élément de la liste est récupérable par c.ElementFromIAccessible(objAcc, objAcc.accChildCount) et en fait quand un élément n'est pas visible le rectangle a ses coordonnées à 0. Le cas de la ListBox2 est plus compliqué car le dernier élément est visible et ses coordonnées sont dans le rectangle de la liste mais il y a peu d'écart entre le bottom du rectangle de la liste et celui du dernier élément. On rajoutant quelques pixels on devrait deviner si il y a la scrollbar ou pas. Exemple :

Function SBV_visible(c As CUIAutomation, objAcc As IAccessible) As Boolean
Dim UIA_elem As IUIAutomationElement, rectL As tagRECT, rectC As tagRECT
Set UIA_elem = c.ElementFromIAccessible(objAcc, 0)
rectL = UIA_elem.CurrentBoundingRectangle
Debug.Print rectL.bottom
Set UIA_elem = c.ElementFromIAccessible(objAcc, objAcc.accChildCount)
rectC = UIA_elem.CurrentBoundingRectangle
Debug.Print rectC.bottom
If rectC.bottom = 0 Or (rectC.bottom + 4 > rectL.bottom) Then SBV_visible = True Else SBV_visible = False
End Function

Ecart peut être à ajuster.
Ne pas oublier de mettre UIAutomationclient dans les références.

Ami calmant, J.P

 

[Dudu2]

Merci @jurassic pork pour ton exemple UIAutomation dont tu es un spécialiste et dont bien sûr je ne comprends que peu de choses.
Je ne sais pas utiliser ta fonction Function SBV_visible(c As CUIAutomation, objAcc As IAccessible) As Boolean car je ne sais pas ce que l'argument "c" représente.

 

[jurassic pork]

Je ne sais pas utiliser ta fonction Function SBV_visible(c As CUIAutomation, objAcc As IAccessible) As Boolean car je ne sais pas ce que l'argument "c" représente.

Hello Dudu2 ,
ben regarde bien mon exemple on voit ce que c'est dans la procédure de test, c est un objet CUIAutomation initialisé. Je ne l'ai pas mis dans la fonction pour éviter de le recréer à chaque fois dans la fonction.
Ami calmant, J.P