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 ?

 

[Dudu2]

Il y a quand même un point soulevé par @Rheeem en Post #110 qui questionne ce qu'on fait depuis toujours avec les APIs de type WindowFromPoint().

Cette déclaration pour 32bit est fausse mais fonctionne,, elle exploite une particularité de la convention de passage des paramètres vers la pile STDCALL ou l'argument Point est remplacé par deux arguments de type Long.

Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long

Si cela est vrai, et ça semble l'être, je comprends alors pourquoi il place un Currency dans toutes les déclarations (64 et 32 bits).
Doit-on adopter cette méthode pour la facilité qu'elle procure et qui va à l'encontre de ce qu'on voit sur tous les sites ?
Ou toujours distinguer seulement le #Win64 pour faire le LSet ou CopyMemory ?

A ce propos, un comparatif LSet et CopyMemory pour s'assurer que c'est la même chose.
Le LSet semble bien plus pratique !

 

[patricktoulon]

Bonjour
ben oui Lset est bien plus pratique selon moi
et on a pas le soucis avec any ou long dans les arguments de copymemory

c'est bizarre que chez moi le focus n'est pas nécessaire

avec focus j'ai 0 ou (1 )bien attendu on s'y attendent
sans focus j'ai 0 ou (5 )
perso peut m'importe c'est le zero qui m’intéresse

 

[jurassic pork]

Hello,
quelque chose m'intriguait avec le problème de récupération du BoundingRectangle de la ListBox qui ne fonctionnait pas sous Windows 7 dans mon classeur HasSb JP V3.xlsm : Quand j'utilisait le classeur de Jafaar Tribak avec sa classe C_AccEx et son programme de test qui balayait tous les éléments d'Excel en affichant leurs propriétés, sous Windows 7, je récupérait les bonnes coordonnées pour le BoundingRectangle d'une ListBox.
Après différents tests je me suis aperçu que c'était ma fonction c.ElementFromIAccessible qui ne fonctionnait pas bien : on récupérait le bon élément mais apparemment toutes les propriétés pour le IUAutomationElement n'étaient pas récupérées en particulier le BoundingRectangle. C'est alors que j'ai cherché un autre moyen de récupérer le IUAutomationElement et c'est alors que j'ai découvert la fonction magique de IUAutomation : GetFocusedElement . On récupère le IUAutomationElement de l'objet qui a le focus.
Et alors mon code devient :

Function HasSb(ByVal ListBox) As Boolean
    Dim c As New CUIAutomation, Condition As IUIAutomationCondition
    Dim zoom, rect1 As tagRECT, rect2 As tagRECT
    Dim UIA_LB As IUIAutomationElement, UIA_LBI As IUIAutomationElement
    If ListBox.ListCount = 0 Then Exit Function
    ' on met le focus sur l'élément
    If TypeOf ListBox.Parent Is Worksheet Then
        zoom = ActiveWindow.zoom / 100
        ListBox.Activate
    Else
        zoom = GetUserFormFromControl(ListBox).zoom / 100
        ListBox.SetFocus
    End If
    Set UIA_LB = c.GetFocusedElement() ' récupération de l'élément qui a le focus
    Set Condition = c.CreatePropertyCondition(UIAutomationClient.UIA_ControlTypePropertyId, 50007) ' ListItem = 50007
    Set UIA_LBI = UIA_LB.FindFirst(TreeScope_Descendants, Condition) 'premier élément de liste
    rect1 = UIA_LB.CurrentBoundingRectangle
    rect2 = UIA_LBI.CurrentBoundingRectangle
     ' Debug.Print rect1.right - rect2.right, 10 * zoom
    HasSb = ((rect1.right - rect2.right) > (10 * zoom))
End Function

'-------------------------
'Get UserForm from Control
'-------------------------
Private Function GetUserFormFromControl(Control) As Object
    Dim Object As Object
    Set Object = Control
    Do While TypeOf Object Is MSForms.Control
        Set Object = Object.Parent
    Loop
    Set GetUserFormFromControl = Object
End Function

Pour savoir si il y a une Scrollbar dans la lisbox on teste le bord droit de la ListBox par rapport au bord droit de son premier élément. Si il y a une différence notable, c'est qu'il y a la scrollBar.
Testé OK sous Excel 2007, Excel 2010 sous Windows 7 SP1 (zoom de 50, 100 et 150)
Excel 2016 Windows 11, Excel 2021 64 bits Windows 11
Excel 2007, 2013 Windows 10
Plus besoin d'API.
Le classeur de test en pièce jointe. J'ai rajouté un bouton qui permet de "rectifier" l'aspect des contrôles activex des feuilles (ex : double affichage). Ce défaut d'aspect peut apparaître quand on manipule le classeur sous différents O.S ou versions d'Excel et facteurs d'échelle.

Ami calmant, J.P

 

[Dudu2]

Bonjour,
Solution corrigée.
Entre le TreeScope_Descendants et la valorisation de la Condition, c'est vraiment un truc de l'espace !
Pour info la différence entre les rectangles c'est au minimum la largeur de la ScrollBar qu'on peut obtenir avec GetSystemMetrics(SM_CXVSCROLL), 21 pixels chez moi. S'y ajoutent les bordures du SpecialEffect.

 

[patricktoulon]

Bonjour à tout les deux
juste en passant
chez moi çà fonctionne le #124

 

[jurassic pork]

Hello,
finalement il existe peut-être une solution simple qui fonctionne partout. Après différents essais de code dans un autre forum, le magicien Jafaar Tribak m'a montré que ma solution V4 ne fonctionnait pas dans tous les cas (à cause du focus qui en plus ralentit) et il m'a sorti un code qui utilise que du IAccessible. Ce genre de solution , je l'avais déjà envisagé suite à la contribution de Rheeem mais voilà cela ne fonctionnait pas sous Windows 7, accLocation retournait des coordonnées nulles. Mais Jafaar Tribak procède autrement : il fait accLocation sur le premier élément de la ListBox et là ça fonctionne accLocation récupère bien les coordonnées du premier élément de la listbox sous windows 7. Ensuite Jafaar Tribak fait un accHitTest par rapport aux coordonnées récupérés avec un petit offset de 2 pour tester la droite du premier élément. Voici ce que renvoit accHitTest :
[out, retval] pvarChild
Type: VARIANT*
[out, retval] Adresse d'un VARIANT qui identifie l'objet affiché au point spécifié par xGauche et yTop. Les informations sont retournées dans pvarID dépend de l'emplacement du point spécifié par rapport à l'objet dont accHitTest la méthode est appelée.

En dehors des limites de l'objet, et à l'intérieur ou à l'extérieur du rectangle de délimitation de l'objet.	VT_EM	Aucun.
Dans l'objet mais pas dans un élément enfant ou un objet enfant.	VT_I4	lVal est CHILDID_SELF.
Dans un élément enfant.	VT_I4	lVal contient l'ID enfant.
Dans un objet enfant.	VT_DISPATCH	pdispVal est défini sur l'objet enfant IDispatch pointeur d'interface

voici le code de Jaafar Tribaak qui n'est prévu que pour une listeBox en feuille :

Function HasScrollBar(ByVal Lbx As Object) As Boolean
    Dim iAcc As IAccessible
    Dim nLeft As Long, nTop As Long, nWidth As Long, nHeight As Long
    Dim sngZoom As Single
    Set iAcc = Lbx
    sngZoom = ActiveWindow.zoom / 100&
    If Lbx.ListCount Then
        Call iAcc.accLocation(nLeft, nTop, nWidth, nHeight, 1&)
        HasScrollBar = VarType(iAcc.accHitTest((nLeft + nWidth + 2& * sngZoom), nTop + 2& * sngZoom)) = vbLong
    End If
End Function

Sub Test()
    MsgBox HasScrollBar(Sheet1.ListBox1)
End Sub

En fait quand il y a la Scrollbar dans la ListBox on est dans le cas 2 avec une valeur de retour à 0 de type vbLong .
Quand il n'y a pas de scrollbar on se retrouve à l'extérieur de la ListBox et cela renvoie un VT_EMPTY.
J'ai modifié le code de Jafaar pour éliminer la contrainte du zoom et j'utilise un offset de 8 qui semble OK pour un zoom raisonnable de 50 à 150 (sinon zoom trop petit ou zoom trop grand). Cette valeur de 8 a été choisie en fonction de la largeur du scrollbar (17) et de la largeur max des effets spéciaux (3).

Function HasScrollBar(ByVal Lbx As Object) As Boolean
    Dim iAcc As IAccessible
    Dim nLeft As Long, nTop As Long, nWidth As Long, nHeight As Long
    Set iAcc = Lbx
    If Lbx.ListCount Then
        Call iAcc.accLocation(nLeft, nTop, nWidth, nHeight, 1&)
        HasScrollBar = VarType(iAcc.accHitTest((nLeft + nWidth + 8&), nTop + 8&)) = vbLong
    End If
End Function

Pour les tests , j'ai rajouté un paramètre pour le zoom et un pour les effets spéciaux :

Sub TestSB()
    Const Zoom = 100, SpeEff = 0 ' 0 = Flat  6 = Bump
    ActiveSheet.ListBox1.SpecialEffect = SpeEff: ActiveSheet.ListBox2.SpecialEffect = SpeEff
    ActiveSheet.ListBox3.SpecialEffect = SpeEff
    UserForm1.ListBox1.SpecialEffect = SpeEff: UserForm1.ListBox2.SpecialEffect = SpeEff
    ActiveWindow.Zoom = Zoom:   UserForm1.Zoom = Zoom
    Range("C4") = HasScrollBar(ActiveSheet.ListBox1)
    Range("C5") = HasScrollBar(ActiveSheet.ListBox2)
    Range("C6") = HasScrollBar(ActiveSheet.ListBox3)
    UserForm1.Show
    ActiveWindow.Zoom = 100:   UserForm1.Zoom = 100
    Range("C4") = ""
    Range("C5") = ""
    Range("C6") = ""
    Range("E5") = ""
    Range("E6") = ""
End Sub

En pièce jointe le classeur de test.

Cela me semble OK sur tous mes excel et tous mes O.S et en particulier Windows 7.

Ami calmant, J.P

 

[Dudu2]

Bonjour,
Pas mal du tout ! Ça évite le Focus.
8 ça couvre juste le zoom 50% (17/2) (21/2 chez moi) et ça permet de faire une fonction très courte.
Ceci dit ré-introduire le zoom ne serait pas une hérésie.

 

[Dudu2]

Finalement le Zoom n'a d'effet que sur le décalage latéral.
En fait si on prend l'accLocation du 1er élément, la ScrollBar devrait se trouver à une distance de +1 à droite et +1 en haut.
Or, si le décalage en haut de +1 est valide quelque soit le Zoom, le décalage minimum à droite varie de +1 à 10% et +15 à 300%.

Edit: Les écarts latéraux chez moi. Même Zoom sur la feuille et sur le UserForm.
Il s'avère que le Zoom / 10 donne une valeur acceptable.

Ce qui donnerait ça selon le code de @jurassic pork.

 

[patricktoulon]

re
bonjour tout les deux
et oui Iaccessible est dans ce registre mieux que uiautomation
et en plus là on passe par le com et non les fonction de l'api

y a pas a dire il est fort ce jaafar Tribak

edit :testé chez moi et tout fonctionne avec zoom ou sans zoom

 

[patricktoulon]

re
on réintroduit le zoom car 8 c'est la moitié de la taille d'origine de la scroll
et pour ne pas avoir a ajouter la fonction de JP pour recuperer le parent ancestor(userform) on injecte l'argument optional

voila ce que ça donne

Function HasScrollBarVX(ByVal Lbx As Object, Optional uf As Object = Nothing) As Boolean
    Dim iAcc As IAccessible
    Dim nLeft As Long, nTop As Long, nWidth As Long, nHeight As Long, Z#
    Set iAcc = Lbx
    If Lbx.Parent Is ActiveSheet Then
        Z = ActiveWindow.Zoom / 100
    Else
        If Not uf Is Nothing Then Z = uf.Zoom / 100
    End If
    If Lbx.ListCount Then
        Call iAcc.accLocation(nLeft, nTop, nWidth, nHeight, 1&)
        HasScrollBarVX = VarType(iAcc.accHitTest((nLeft + nWidth + 8& * Z), nTop + 8& * Z)) = vbLong
    End If
End Function

msgbox HasScrollBarVX(feuil1.listbox1)'pour feuille

msgbox HasScrollBarVX(listbox1,Me)'pour userform
terminé ça match perfectly chez moi sur 2013 32 et 2016 64

 

[Rheeem]

Bonjour,

Vous ne pensez pas qu'il faut mettre Lb.TopIndex + 1 au lieu de de 1& si le but est de trouver le premier élément visible

 

[patricktoulon]

re
@Rheeem
Bonne question à méditer

 

[jurassic pork]

Vous ne pensez pas qu'il faut mettre Lb.TopIndex + 1 au lieu de de 1& si le but est de trouver le premier élément visible

Hello,
excellente remarque , effectivement si le premier élément visible n'est pas le premier élément de la liste , le code ne fonctionne pas :

Donc corriger avec

Call iAcc.accLocation(nLeft, nTop, nWidth, nHeight, Lbx.TopIndex + 1&)

Cela semble OK , en attendant de voir si on trouve un autre cas qui ne fonctionne pas.

Ami calmant, J.P

 

[jurassic pork]

Hello,
Dudu2 la solution que tu pointes dans ta discussion, ne fonctionne pas dans tous les cas. Celle de mon message précédent est plus adéquate.
Ami calmant, J.P