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 ?

 

[patricktoulon]

moi j'ai fait ça entre temps pour les userforms aussi

'Fonction pour savoir si une listbox a la scrollbar d'affichée ou pas
'patricktoulon
'Rheeem
'jurassic pork
'dudu2
Option Explicit
#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
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As rect) 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
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As rect) As Long
#End If

Private Const SM_CXVSCROLL = 2
Private Type rect: left As Long: top As Long: right As Long: bottom As Long: End Type
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&, IAcObj As IAccessible, rc As rect
    retrait = GetSystemMetrics(SM_CXVSCROLL) / 2
    If Lb.ListCount = 0 Then Exit Function
    If TypeOf Lb.Parent Is Worksheet Then
        With ActiveWindow.ActivePane
            b.X = .PointsToScreenPixelsX(Lb.left + Lb.Width - retrait)
            b.Y = .PointsToScreenPixelsY(Lb.top + retrait)
        End With
    Else
        #If VBA7 Then
            Dim Handl As LongPtr
        #Else
            Dim Handl As Long
        #End If
        Set IAcObj = Lb
        WindowFromAccessibleObject IAcObj, Handl
        GetWindowRect Handl, rc
        b.X = rc.right - retrait
        b.Y = rc.top + retrait
    End If
    LSet pz = b
    AccessibleObjectFromPoint pz.Dt, cc, v
    HasScrollbarVX = v = 0
End Function

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

et c'est nikel ca marche

perso je préfère garder le pointstoscreenpixel chez moi il est hyper précis mais je suppose que tu pourrais l'enlever et utiliser le windowfromaccessibleobject et le getwindowrect pour les deux

testez le fichier

 

[patricktoulon]

re
ca marche aussi sans pointtoscreenpixel la marge largeur scrollbar/2 est suffisante

'Fonction pour savoir si une listbox a la scrollbar d'affichée ou pas
'patricktoulon
'Rheeem
'jurassic pork
'dudu2
Option Explicit
#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
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As rect) 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
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As rect) As Long
#End If

Private Const SM_CXVSCROLL = 2
Private Type rect: left As Long: top As Long: right As Long: bottom As Long: End Type
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&, IAcObj As IAccessible, rc As rect
    retrait = GetSystemMetrics(SM_CXVSCROLL) / 2
    If Lb.ListCount = 0 Then Exit Function
    #If VBA7 Then
        Dim Handl As LongPtr
    #Else
        Dim Handl As Long
    #End If
    Set IAcObj = Lb
    WindowFromAccessibleObject IAcObj, Handl
    GetWindowRect Handl, rc
    b.X = rc.right - retrait
    b.Y = rc.top + retrait

    LSet pz = b
    AccessibleObjectFromPoint pz.Dt, cc, v
    HasScrollbarVX = v = 0
End Function

 

[Nicolas JACQUIN]

moi j'ai fait ça entre temps pour les userforms aussi

'Fonction pour savoir si une listbox a la scrollbar d'affichée ou pas
'patricktoulon
'Rheeem
'jurassic pork
'dudu2
Option Explicit
#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
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As rect) 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
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As rect) As Long
#End If

Private Const SM_CXVSCROLL = 2
Private Type rect: left As Long: top As Long: right As Long: bottom As Long: End Type
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&, IAcObj As IAccessible, rc As rect
    retrait = GetSystemMetrics(SM_CXVSCROLL) / 2
    If Lb.ListCount = 0 Then Exit Function
    If TypeOf Lb.Parent Is Worksheet Then
        With ActiveWindow.ActivePane
            b.X = .PointsToScreenPixelsX(Lb.left + Lb.Width - retrait)
            b.Y = .PointsToScreenPixelsY(Lb.top + retrait)
        End With
    Else
        #If VBA7 Then
            Dim Handl As LongPtr
        #Else
            Dim Handl As Long
        #End If
        Set IAcObj = Lb
        WindowFromAccessibleObject IAcObj, Handl
        GetWindowRect Handl, rc
        b.X = rc.right - retrait
        b.Y = rc.top + retrait
    End If
    LSet pz = b
    AccessibleObjectFromPoint pz.Dt, cc, v
    HasScrollbarVX = v = 0
End Function

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

et c'est nikel ca marche
Regarde la pièce jointe 1216777

Regarde la pièce jointe 1216778
perso je préfère garder le pointstoscreenpixel chez moi il est hyper précis mais je suppose que tu pourrais l'enlever et utiliser le windowfromaccessibleobject et le getwindowrect pour les deux

testez le fichier

Bonjour à tous,
Chez moi ça ne donne pas pareil Patrick !
Je suis obligé de cliquer sur la listbox du userform pour que ça ne détecte ou pas
Nicolas.

 

[jurassic pork]

Pour bien comprendre la partie du code de patrick et en particulier le v qui est renvoyé par la fonction :

AccessibleObjectFromPoint pz, Dt, cc, v

pour la suite : ppacc = cc et pvarChild = v
[out] pvarChild

Adresse d’une structure VARIANT qui spécifie si le pointeur d’interface IAccessible retourné dans ppacc appartient à l’objet affiché au point spécifié ou au parent de l’élément au point spécifié. Le membre vt du VARIANT est toujours VT_I4. Si le membre lVal est CHILDID_SELF, le pointeur d’interface IAccessible à ppacc appartient à l’objet au point. Si le membre lVal n’est pas CHILDID_SELF, ppacc est l’adresse de l’interface IAccessible de l’objet parent de l’élément enfant. Les clients doivent appeler VariantClear sur le paramètre VARIANT récupéré lorsqu’ils ont terminé de l’utiliser.

En fait si il y a la ScrollBar on a 0 (CHILDID_SELF) car l'objet est en fait la ListBox
quand c'est différent de 0 c'est que c'est un objet enfant (un élément par exemple) et le IAccessible cc renvoyé est celui du parent.
C'est pour cela que je me retrouve toujours avec cc qui est la ListBox. Cela correspond au fait que quand il y a la ScrollBar les éléments ne vont pas jusqu'à l'endroit où l'on fait le AccessibleObjectFromPoint.

 

[patricktoulon]

re
Bonjour
click d'abord sur l'userform pour qu'il ai le focus
bienvenu dans excel2021 click&run pipé

 

[patricktoulon]

re
@jurassic pork

En fait si il y a la ScrollBar on a 0 (CHILDID_SELF) car l'objet est en fait la ListBox
quand c'est différent de 0 c'est que c'est un objet enfant (un élément par exemple) et le IAccessible cc renvoyé est celui du parent.
C'est pour cela que je me retrouve toujours avec cc qui est la ListBox.

normalement ca devrait te renvoyer rien du tout car en mettant V(variant) a la place d'un numerique ca devrait te renvoyer 0 puisque pas d'enfant capté mais ca devrait pas te renvoyer le accessible listbox

 

[jurassic pork]

normalement ca devrait te renvoyer rien du tout car en mettant V(variant) a la place d'un numerique ca devrait te renvoyer 0 puisque pas d'enfant capté mais ca devrait pas te renvoyer le accessible listbox

Essaie cela , tu vas voir :

   AccessibleObjectFromPoint pz.Dt, cc, v
   Debug.Print v, cc.accRole
   HasScrollbarVX = v = 0

 

[patricktoulon]

re
ca y est j'ai pigé en fait quand il n'y a pas de scrollbar tu a la listbox et pas l'item
si c'est ça c'est pas grave puisqu'ici on se contente de recevoir un retour ou pas
maintenant si tu dois travailler sur les childs alors tu a un problème

 

[patricktoulon]

Ben c'est normal que cc te renvoie la listbox non?puisque c'est le parent

 

[jurassic pork]

essaie cela :

  Debug.Print v, cc.accHitTest(b.X, b.Y), cc.accRole

cc.accHitTest(b.X, b.Y) à la même info que v

 

[patricktoulon]

et je viens de découvrir aussi que le accrole donne un resultat différent selon si le control a le focus ou pas dans les userforms
regarde bien

 

[patricktoulon]

essaie cela :

  Debug.Print v, cc.accHitTest(b.X, b.Y), cc.accRole

cc.accHitTest(b.X, b.Y) à la même info que v

a ben si tu essaie sur les listboxs dans feuille , tu peux toujours courir ,tu le sais que ça ne fonctionne pas 😉 on a déjà vu ça

accRole --> fonctionne sur feuille et userform
accName--> fonctionne pas renvoie empty dans les userform (mais ne déclenche pas d'erreurs dans les userforms)
acc.location -->fonctionne que sur userform
accHitTest--> fonction que sur userform

 

[patricktoulon]

pour moi les résultats sont corrects
1 1 33
1 1 33
1 1 33
1 1 33
1 1 33
1 1 33
1 1 33
0 0 33
0 0 33
0 0 33
0 0 33
0 0 33
0 0 33
0 0 33
si ca renvoie 1 c'est que le child est capté et le cc.accRole te renvoie bien le type 33 qui est une fenêtre liste
si je ne me trompe pas
V n'est pas sensé renvoyer un object item ou quoi que se soit d'autre il est juste là pour renvoyer 0 ou 1 si il y a bien un child sur les point x et y

 

[Dudu2]

Un HitTest ça suffit.

 

[jurassic pork]

a ben si tu essaie sur les listboxs dans feuille , tu peux toujours courir ,tu le sais que ça ne fonctionne pas 😉 on a déjà vu ça

accRole --> fonctionne sur feuille et userform
accName--> fonctionne pas renvoie empty dans les userform (mais ne déclenche pas d'erreurs dans les userforms)
acc.location -->fonctionne que sur userform
accHitTest--> fonction que sur userform

je vais faire des tests complémentaires cela doit dépendre de l'O.S et de la version d'Excel.
En tout cas quelque chose qui fonctionne sur mon Excel 2021 Windows 11 :

Function HasSb(ByVal ListBox) As Boolean
    Dim IAListBox As IAccessible
    Dim c As New CUIAutomation, UIA_elem As IUIAutomationElement, rectLB As tagRECT
    If ListBox.ListCount = 0 Then Exit Function
    Set IAListBox = ListBox
    Set UIA_elem = c.ElementFromIAccessible(IAListBox, 0)
    rectLB = UIA_elem.CurrentBoundingRectangle
    HasSb = IAListBox.accHitTest(rectLB.Right - 5, rectLB.Top + 5)
    HasSb = Not HasSb
End Function