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 ?

 

[Rheeem]

J'ai posté un code essaie de l'adapté :

Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal Rw As Currency, ppacc As IAccessible, pvarChild As Variant) As Long
Private Type CPoint
  X As Long
  Y As Long
End Type
Private Type CRw
  Dt As Currency
End Type
Private Function HasSb(ByVal Lb As MSForms.ListBox) As Boolean
Dim ac As IAccessible, cc As IAccessible
Dim p(0 To 3) As Long, b As CPoint, pz As CRw, 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
b.X = p(0) + p(2) - 5
b.Y = p(1) + 5
LSet pz = b
AccessibleObjectFromPoint pz.Dt, cc, v
HasSb = v <> 0
End Function
[code]

 

[Dudu2]

Ouais, ok, à "adapter" !
Ça marche pas ton truc.

 

[jurassic pork]

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

C'est la fonction accLocation de l'IAccessible de la listbox placée dans un classeur qui renvoie rien donc impossible d'appeler accHitTest de IAccessible pour faire le test,, Pour contourner ce problème il est possible d'utiliser AccessibleObjectFromPoint ,avec un principe simple: récupérer IAccessible dans le point haut doit si le scrollbar est présent AccessibleObjectFromPoint renvoie le bouton Up sinon c'est l'élément TopIndex qui est renvoyé ,, j'avais déjà expliqué ca ...

Hello,
Rheeem tu es sûr de ce que tu avances ? parce que j'ai regardé avec FlaUIInspect, il n'y a pas d'objet Bouton Up. Les Seuls objets pour la ListBox sont la ListBox et ses éléments. Le Bouton UP n'est pas accessible. Par contre j'ai une nouvelle piste : Quand il y a la ScrollBar la taille horizontale des éléments est inférieure à celle de la ListBox (Taille - largeur de la ScrollBar).
Ami calmant, J.P

 

[patricktoulon]

re
Bonjour
@jurassic pork
oui j'ai essayé moi aussi hier et ça donne rien en tout cas sur les listbox sur feuille
que veux tu dire par là "taille horizontal des éléments"

 

[jurassic pork]

@jurassic pork
oui j'ai essayé moi aussi hier et ça donne rien en tout cas sur les listbox sur feuille
que veux tu dire par là "taille horizontal des éléments"

Hello patrick,

 

[patricktoulon]

ok j'ai pigé
re comme le acclocation ne fonctionne pas sur les listbox sur feuille je suis passé par pointtoscreenpixel
j'ai ajouté setcursorpos pour vérifier que je tombe bien dessus(et c'est le cas)

donc basé sur l'idée de @Rheeem

Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal Rw As Currency, ppacc As IAccessible, pvarChild As Variant) As Long
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type CPoint
    x As Long
    y As Long
End Type
Private Type CRw
    Dt As Currency
End Type
Private Function HasSb(ByVal Lb As MSForms.ListBox) As Boolean
    Dim ac As IAccessible, cc As IAccessible
    Dim p(0 To 3) As Long, b As CPoint, pz As CRw, v As Variant
    If Lb.ListCount = 0 Then Exit Function
    Set ac = Lb
    With ActiveWindow.ActivePane
        b.x = .PointsToScreenPixelsX(Lb.Left + Lb.Width - 6)
        b.y = .PointsToScreenPixelsY(Lb.Top + 4)
    End With
   SetCursorPos b.x, b.y
   LSet pz = b
    AccessibleObjectFromPoint pz.Dt, cc, v
    HasSb = v <> 0
End Function

Sub test()
     [a1]=HasSb Feuil1.ListBox1
End Sub

et je confirme que ça ne fonctionne pas

 

[jurassic pork]

Basé sur ma dernière idée :

Sub Test()
    HasSb ActiveSheet.ListBox1, ActiveSheet.Range("C4"), ActiveSheet.Range("D4")
    HasSb ActiveSheet.ListBox2, ActiveSheet.Range("C5"), ActiveSheet.Range("D5")
    HasSb ActiveSheet.ListBox3, ActiveSheet.Range("C6"), ActiveSheet.Range("D6")
End Sub

Function HasSb(ByVal ListBox As Object, colLB, colSB) As Boolean 
   Dim IAListBox As IAccessible   
   Dim c As New CUIAutomation, UIA_elem As IUIAutomationElement, rectLB As tagRECT, rectElem As tagRECT
    If ListBox.ListCount = 0 Then Exit Function
    Set IAListBox = ListBox
    Set UIA_elem = c.ElementFromIAccessible(IAListBox, 0)
    rectLB = UIA_elem.CurrentBoundingRectangle
    Set UIA_elem = c.ElementFromIAccessible(IAListBox, 1)
    rectElem = UIA_elem.CurrentBoundingRectangle
    '    Debug.Print rectLB.Right, rectElem.Right
    colLB.Value = rectLB.Right
    colSB.Value = rectElem.Right
End Function

La formule dans la colonne est :

=SI(C4 < D4 +5;"Pas de ScrollBar";"ScrollBar présente")

 

[patricktoulon]

re
punaise de punaise de punaise de punaise ..............
c'est @rheem qui a raison
sauf qu'il s'y est mal pris
en fait il faut pas "<>0 mais "=0"
car si v=0 ca veut dire qu'il ne capte pas le child (1) en top+4 et right-6

donc on reprend
renvoie true si la scrollbar est presente sinon false

Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal Rw As Currency, ppacc As IAccessible, pvarChild As Variant) As Long
'Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type CPoint: x As Long: y As Long: End Type
Private Type CRw: Dt As Currency: End Type
Private Function HasScrollbarVX(ByVal Lb As MSForms.ListBox) As Boolean
    Dim cc As IAccessible
    Dim b As CPoint, pz As CRw, v As Variant
    If Lb.ListCount = 0 Then Exit Function
    With ActiveWindow.ActivePane
        b.x = .PointsToScreenPixelsX(Lb.Left + Lb.Width - 6)
        b.y = .PointsToScreenPixelsY(Lb.Top + 3)
    End With
    'SetCursorPos b.x, b.y
    LSet pz = b
    AccessibleObjectFromPoint pz.Dt, cc, v
    HasScrollbarVX = v = 0
End Function

Sub test()
    [b1] = HasScrollbarVX(Feuil1.ListBox1)
End Sub

donc il y avait à

1. changer la mecanique de l'obtention des coordonnée top et right(car acc.location ne fonctionne pas sur listbox dans feuille)
2. et changer l’opération logique final

ca fonctionne nikel !!!!!

 

[patricktoulon]

re
Adapté sur le move de la listbox

et ca fonctionne même avec une scrollbar sans course

 

[jurassic pork]

Patrick c'est peut-être la même chose que l'on teste (mais différemment) parce que les IAccessibles que tu récupèrent cela doit être la listbox et les éléments, essaie de voir quel type de IAccessible tu récupères.

 

[patricktoulon]

re
@jurassic pork
ben c'est là le problème justement c'est que sur la scroll acc.role ne renvoie rien puisque rien n'est capté donc v=0
la scrollbar est incapable avec iaccessible
c'est ça l'astuce

1. soit on capte le child(1) qui n'est rien d'autres que l'item(1)
2. soit on capte rien rien

si on capte rien aux coordonnée right-..) et top+... c'est quelle est là tout simplement

@Rheeem avait presque raison en fait
sauf que les property ccrole ou acc.location ne sont pas dispos avec les controls dans feuille

 

[Dudu2]

Bonjour,

Quand il y a la ScrollBar la taille horizontale des éléments est inférieure à celle de la ListBox (Taille - largeur de la ScrollBar).

Voir le Post #38:

En fait, je comprends rien à ton code magique, mais j'ai pu l'adapter après avoir constaté les différences des RECT.Width pour éliminer ce + 4.
Quand la Scroll Bar est présente avec SpecialEffect = fmSpecialEffectFlat la différence est exactement la largeur de la Scroll Bar récupérée par GetSystemMetrics

 

[patricktoulon]

@Dudu2
regarde le post #54
l'astuce est hyper simple
iaccessible ne capte rien du tout aux coordonnées de right(-....) et top +(...)
on peut travailler plus proprement si ,tu veux avec la largeur scrollbar /2 avec le getsystemmetrics et const scrollbar

 

[patricktoulon]

et là voila au propre avec le getsystemmétric+const scrollbar

#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal Rw As Currency, ppacc As IAccessible, pvarChild As Variant) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal Rw As Currency, ppacc As IAccessible, pvarChild As Variant) As Long
#End If

Private Const SM_CXVSCROLL = 2

Private Type CPoint: X As Long: Y As Long: End Type
Private Type CRw: Dt As Currency: End Type
 
 Function HasScrollbarVX(ByVal Lb As MSForms.ListBox) As Boolean
    Dim cc As IAccessible, b As CPoint, pz As CRw, v As Variant
    retrait = GetSystemMetrics(SM_CXVSCROLL) / 2
    If Lb.ListCount = 0 Then Exit Function
    With ActiveWindow.ActivePane
        b.X = .PointsToScreenPixelsX(Lb.Left + Lb.Width - retrait)
        b.Y = .PointsToScreenPixelsY(Lb.Top + retrait)
    End With
     LSet pz = b
    AccessibleObjectFromPoint pz.Dt, cc, v
    HasScrollbarVX = v = 0
End Function

Sub test()
    MsgBox HasScrollbarVX(Feuil1.ListBox1)
End Sub

pour info
quand je le fait avec getwindowrect et WindowFromAccessibleObject mon restangle est decalé de 2.7 point soit 3.6 pixel
mais nous connaissons bien la chose
tandis qu'avec pointstoscreenpixel decalage (0)
peut être (car c'est logique) faudra t il multiplier par coeef zoom le "lb.Width"
mais en tout cas cette méthode (soit item(1) soit rien) me parait clairement la meilleurs car on ne subit pas les problème de non fonctionnement des property accRole ou encore acc.location et autres
soit on capte soit on capte pas
net et clair 😉

un petit like 👍 pour @Rheeem qui m'a mis sur la voie

edit: même pas le lb.width est dans les parenthèses du pointstoscreenpixel donc on laisse comme ça

 

[Dudu2]

Voilà le fichier selon la méthode de @Rheeem adaptée par @patricktoulon.
Ne peut-on remplacer ce Currency ?
Est-ce que ça fonctionne en 32 bits et en VB6 ?