Autres tester le scroll de la frame

[patricktoulon]

bonjour à tous
est ce que plusieurs d'entre vous pourraient tester le scroll de la frame avec la mollette sur des versions 365 2019 et 2021 svp
merci pour les retours

 

[fanch55]

Un peu galéré avec le combobox qui fait planter le LowLevelMouseProc puis Excel lorsque qu'on n'a pas fait le dropdown ....
J'ai modifié le code comme ci-dessous et je n'ai plus aucun plantage ( conclusion: tout va bien en 64 bits maintenant ) :

                Case TypeOf CtrlHooked Is ComboBox Or TypeName(CtrlHooked) = "ComboBox"
                    On Error Resume Next
                    If Mdata > 0 _
                    Then .TopIndex = Application.Max(0, .TopIndex - 1) _
                    Else .TopIndex = Application.Min(.TopIndex + 1, .ListCount)
                    If Err <> 0 Then CtrlHooked.DropDown
                    Err.Clear: On Error GoTo ErrorCritique
                    tim = Timer

Je l'ai même testé sans le Ctrl, tout fonctionne bien ......

 

[patricktoulon]

re
perso je pige pas
vous me disiez cematin que la frame etait en retard la listbox je ne sais quoi et la combo pareil

et ce soir tu me dit que bricoler les limites down et up du scroll par rapport aux positions des listes règle le problème ??????????????????????????????????????????????????????????????????

on est dans la stratosphère là

d'autant plus que !!! ici
Else .TopIndex = Application.Min(.TopIndex + 1, .ListCount)

ca devrait être .listcount-1 car les listes sont en base 0
je vais te dire sincèrement enlève tout et laisse le on error resume next

et en plus tu renvoie sur erro critique qui renvoie sur nettoyage et donc ferme et recomence

conclusion eleve les app.max/min et laisse les gestions d'erreur tu aura le même résultat

en plus je comprends pas les timer je les ai enlevé maintenant tu m'a dit que c'etait pas bon

essaie celui là et donne moi le code tel que tu la bricoler en entier avec le reste je vais faire des debug pour voir

pour l'instant regarde j'ai repris ton idée sans le bricolage des limites ça fonctionne pareil

 Case TypeOf CtrlHooked Is ComboBox Or TypeName(CtrlHooked) = "ComboBox"
                    On Error Resume Next
                    If Mdata > 0 Then .TopIndex = .TopIndex - 1 Else .TopIndex = .TopIndex + 1
                    If Err <> 0 Then CtrlHooked.DropDown
                    Err.Clear: On Error GoTo ErrorCritique

et je suppose que tu a fait pareil pour la listbox ???

 

[Cousinhub]

Bonsoir,
J'ai été le premier à faire ta souris de laboratoire (bon, pas un seul merci, mais tout en étant "déçu", je n'en suis pas moins surpris)
Puis, le truc qui tue

je peux pas attendre que vous soyez dispo a chaque fois que j'ai quelque chose a tester
c'est trop long et je ne peux même pas examiner pourquoi

franchement je me demande qu'est que vous pouvez leur trouver de bien à ces versions 64 bits
vous pouvez plus rien faire avec a part ce que microsoft a concocté pour vous
a quel prix surtout (et là je parle de liberté de developpement vba)

En plus, il faudrait qu'on soit plus réactif..
Et qu'on reste dans la norme (excel 5 au max, sous windows 5.1, peut-être?)
Et de quel prix tu parles? (perso, ma version 2021 a amputé mon compte en banque de 0.90 €)
Ah, je n'avais nullement l'intention de télécharger ta xlam (j'en ai aucune et mon Excel ne s'en porte vraiment pas plus mal)
Alors, stp, parle mieux aux personnes bénévoles qui prennent de leur temps pour essayer de t'aider
Bonne soirée

 

[fanch55]

vous me disiez cematin que la frame etait en retard la listbox je ne sais quoi et la combo pareil

Je confirme que le premier Hook a une latence, que ce soit sur le frame ou un autre.
Je pense qu'on te parle toujours du Frame parce que c'est le premier objet de l'userform ....
C'est peut-être dû au timer ???

Pour le listcount-1, c'est vrai , c'est plus juste.

ca devrait être .listcount-1 car les listes sont en base 0
je vais te dire sincèrement enlève tout et laisse le on error resume next

et en plus tu renvoie sur erro critique qui renvoie sur nettoyage et donc ferme et recomence
conclusion eleve les app.max/min et laisse les gestions d'erreur tu aura le même résultat...

Ok, je remet tout à l'initial, voilà ce que ça donne : erreur de topindex et dès qu'on clique sur ok, Excel se plante

conclusion eleve les app.max/min et laisse les gestions d'erreur tu aura le même résultat

ça, c'est sûr, l'erreur du topindex en dehors des limites de la liste est de ce fait ignorée ( pas très propre celà ),: j'avais du les établir avant de faire le dropdown, sinon crash .

en plus je comprends pas les timer je les ai enlevé maintenant tu m'a dit que c'etait pas bon

Là, je comprend pas, je n'ai rien dit à propos des timers jusqu'à maintenant. Te connaissant, je suppose que tu ne les a pas mis pour le plaisir ?.

et je suppose que tu a fait pareil pour la listbox ???

Pas touché à la listbox: à première vue, le système se fout de son topindex ( l'équipe qui l'a développée ne devait pas être la même que celle du Combobox .... )

 

[patricktoulon]

met toi a ma place
le matin vous me dites un truc le soir vous me dites autres chose (l opposé )
hier vous avez fait pareil
moi aussi je suis bénévole je le fait pas pour moi ça marche très bien chez moi
et c'est toi qui me la demandé le scroll en plus

je m'excuse de m'être e emporté mais depuis trois jour vous m'avez rendu fou
je veux le finir ce truc une bonne fois pour toute
le code d'indentation marche à merveille il n'y a que ça comme ombre au tableau

 

[Cousinhub]

et c'est toi qui me la demandé le scroll en plus

Moi?

 

[patricktoulon]

ok donc tu me dis que la simplification que je t'ai donné ne fonctionne pas

c'est à dormir debout ce truc
donne moi ton code tel qu'il est avec tes modifs

 

[patricktoulon]

@fanch55 tu dis

ça, c'est sûr, l'erreur du topindex en dehors des limites de la liste est de ce fait ignorée ( pas très propre celà ),: j'avais du les établir avant de faire le dropdown, sinon crash .

alors tu gère quoi dans ta gestion d'erreur puisque les app.min et max sont sensées te limiter ?????

 

[fanch55]

@patricktoulon :
Le scroll, c'est moi qui te l'ai suggéré .
J'avais mis les codes de Github pour tester l'indentation en scrollant la textbox .
Tu m'as dit qu'ils n' étaient pas forcément bons et que tu avais mieux.
Dont acte , j'ai dépensé beaucoup d'énergie à tester toutes tes propositions,
je n'ai pas cédé à la facilité de dire ça marche/ça marche pas, j'ai analysé tes codes car ils en valent la peine et essayé de t'apporter d'autres propositions suite à mes réflexions.,
Je te donne le code modifié et qui ne plante pas , je ne sais pas si je vais continuer à tester d'autres modifs, moi aussi je me lasse comme toi .

#If Win64 Then
Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
#Else
Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
On Error GoTo ErrorCritique    ' Improved error handling

Dim Criter As Boolean, i&, Mdata
GetCursorPos pos
Criter = plHooking <> 0    'si le thread plhooking <>0 c'est bon
Criter = Criter And IsArray(EpC)    'si EpC est un array c'est bon
Criter = Criter And Not CtrlHooked Is Nothing    'si CtrlHooked n'est pas nothing c'est bon
Criter = Criter And wParam <> 0    'si wparam <>0alors la struture  de la mouse  a été captée
'et en fin si les coordonnées sont dans le rectangle corespondant au corordonnées du rectangle du control  c'est bon
Criter = Criter And pos.X > EpC(0) And pos.X < EpC(2) And pos.Y > EpC(1) And pos.Y < EpC(3)    ' Get control's coordinates in pixels

If Not Criter Then UnHookMouse: Exit Function    'possibilité non critique criter est false alors on sort(le move sur control refera un nouvel appel)
If (nCode = HC_ACTION) Then    'si ncode renvoie bien action alors on est bon la structure est captée
    If Timer - tim > 2 Then UnHookMouse: Exit Function
    If wParam = WM_MOUSEWHEEL Then    'si wparam renvoie bien 522 soit &H20A  alors la structure est bonne
        LowLevelMouseProc = True    'alors on est true(32 bits relance le hook en looping (pas le 64)
        Mdata = GetHookStruct(lParam).mouseData    'on récupère le mouse data

        With CtrlHooked
           .SetFocus
            'selon le control appellant (ou designé)
            'on testera le typeof et le typename selon les configs typeof renvoie une mauvaise reponse

            Select Case True
                Case TypeOf CtrlHooked Is Frame Or TypeName(CtrlHooked) = "Frame"
                    If Mdata > 0 Then .ScrollTop = .ScrollTop - 45 Else .ScrollTop = .ScrollTop + 45
                    tim = Timer
                Case TypeOf CtrlHooked Is ListBox Or TypeName(CtrlHooked) = "ListBox"
                    If Mdata > 0 Then .TopIndex = .TopIndex - 1 Else .TopIndex = .TopIndex + 1
                    tim = Timer
                   
                Case TypeOf CtrlHooked Is ComboBox Or TypeName(CtrlHooked) = "ComboBox"
                    On Error Resume Next
                    If Mdata > 0 _
                    Then .TopIndex = Application.Max(0, .TopIndex - 1) _
                    Else .TopIndex = Application.Min(.TopIndex + 1, .ListCount)
                    If Err <> 0 Then CtrlHooked.DropDown
                    Err.Clear: On Error GoTo ErrorCritique
                    tim = Timer

                Case TypeOf CtrlHooked Is TextBox Or TypeName(CtrlHooked) = "TextBox"
                    If Mdata > 0 Then
                        .CurLine = Application.Max(0, .CurLine - 2)
                    Else
                        .CurLine = Application.Min(.LineCount - 1, .CurLine + 2)
                    End If
                    tim = Timer

                Case TypeOf CtrlHooked Is ScrollBar Or TypeName(CtrlHooked) = "ScrollBar"
                    If Mdata > 0 Then .Value = .Value - 1 Else .Value = .Value + 1
                    tim = Timer
            End Select
        End With
    End If
    Exit Function    'ici on sort tout c'est bien passé
End If
'----------------------------------'
'Gestion d'erreur critique dans un switch entre deux exit function
Nettoyage:    'ici on a été renvoyé par errorCritique
If Err.Number <> 0 Then Err.Clear: UnHookMouse
On Error GoTo 0
LowLevelMouseProc = CallNextHookEx(plHooking, nCode, wParam, lParam)     'évidemment là on est obligé de rappeller car tout est mort ,dead ,ralbate ,crevé etc...

Debug.Print "on sort en catastrophe de " & CtrlHooked.Name: Exit Function     ' on sort on va pas boucler sur une erreur ca suffit une fois espece de saucisse!!!!

ErrorCritique:
Debug.Print "erreur critique" & CtrlHooked.Name
MsgBox "Une erreur est survenue pendant hook " & vbCrLf & Err.Description, vbCritical, CtrlHooked.Name
Resume Nettoyage     ' on renvoie au nettoyage pour tout nettoyer et relancer avec callnexthook neccessaire cette fois ci car externe à la partie ou tout se passe bien
End Function

 

[fanch55]

@fanch55 tu dis


alors tu gère quoi dans ta gestion d'erreur puisque les app.min et max sont sensées te limiter ?????

Si la "fenêtre" du dropdown n'est pas affichée, Excel ne semble pas trouver la propriété topindex du combobox.
Effarant, non ?

 

[patricktoulon]

ok en effet peut être que tant que ce n'est pas développé on a pas accès a ces property

c'est quand même étonnant vu que l'on a accès a la property listindex

en même temps topindex c'est visuel donc ........

une question si tu bloque les timers est ce que ça marche toujours ???
par ce que ça oui c'est du code sale
j'avais fait juste ca par rapport à la frame (ou le premier control survolé)

il faut juste que je sache si je les enlève ou pas
après si ca marche chez toi et si ca marche chez moi je pense que ca marchera chez tout le monde

 

[patricktoulon]

re testé
chez moi ca fonctionne sans les timer

#If Win64 Then
Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
#Else
Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
On Error GoTo ErrorCritique    ' Improved error handling

Dim Criter As Boolean, i&, Mdata
GetCursorPos pos
Criter = plHooking <> 0    'si le thread plhooking <>0 c'est bon
Criter = Criter And IsArray(EpC)    'si EpC est un array c'est bon
Criter = Criter And Not CtrlHooked Is Nothing    'si CtrlHooked n'est pas nothing c'est bon
Criter = Criter And wParam <> 0    'si wparam <>0alors la struture  de la mouse  a été captée
'et en fin si les coordonnées sont dans le rectangle corespondant au corordonnées du rectangle du control  c'est bon
Criter = Criter And pos.X > EpC(0) And pos.X < EpC(2) And pos.Y > EpC(1) And pos.Y < EpC(3)    ' Get control's coordinates in pixels

If Not Criter Then UnHookMouse: Exit Function    'possibilité non critique criter est false alors on sort(le move sur control refera un nouvel appel)
If (nCode = HC_ACTION) Then    'si ncode renvoie bien action alors on est bon la structure est captée
    'If Timer - tim > 2 Then UnHookMouse: Exit Function
    If wParam = WM_MOUSEWHEEL Then    'si wparam renvoie bien 522 soit &H20A  alors la structure est bonne
        LowLevelMouseProc = True    'alors on est true(32 bits relance le hook en looping (pas le 64)
        Mdata = GetHookStruct(lParam).mouseData    'on récupère le mouse data

        With CtrlHooked
           .SetFocus
            'selon le control appellant (ou designé)
            'on testera le typeof et le typename selon les configs typeof renvoie une mauvaise reponse

            Select Case True
                Case TypeOf CtrlHooked Is Frame Or TypeName(CtrlHooked) = "Frame"
                    If Mdata > 0 Then .ScrollTop = .ScrollTop - 45 Else .ScrollTop = .ScrollTop + 45
                    'tim = Timer
                Case TypeOf CtrlHooked Is ListBox Or TypeName(CtrlHooked) = "ListBox"
                    If Mdata > 0 Then .TopIndex = .TopIndex - 1 Else .TopIndex = .TopIndex + 1
                    'tim = Timer
                    
                Case TypeOf CtrlHooked Is ComboBox Or TypeName(CtrlHooked) = "ComboBox"
                    On Error Resume Next
                    If Mdata > 0 _
                    Then .TopIndex = Application.Max(0, .TopIndex - 1) _
                    Else .TopIndex = Application.Min(.TopIndex + 1, .ListCount)
                    If Err <> 0 Then CtrlHooked.DropDown
                    Err.Clear: On Error GoTo ErrorCritique
                    'tim = Timer

                Case TypeOf CtrlHooked Is TextBox Or TypeName(CtrlHooked) = "TextBox"
                    If Mdata > 0 Then
                        .CurLine = Application.Max(0, .CurLine - 2)
                    Else
                        .CurLine = Application.Min(.LineCount - 1, .CurLine + 2)
                    End If
                    'tim = Timer

                Case TypeOf CtrlHooked Is ScrollBar Or TypeName(CtrlHooked) = "ScrollBar"
                    If Mdata > 0 Then .Value = .Value - 1 Else .Value = .Value + 1
                    'tim = Timer
            End Select
        End With
    End If
    Exit Function    'ici on sort tout c'est bien passé
End If
'----------------------------------'
'Gestion d'erreur critique dans un switch entre deux exit function
Nettoyage:    'ici on a été renvoyé par errorCritique
If Err.Number <> 0 Then Err.Clear: UnHookMouse
On Error GoTo 0
LowLevelMouseProc = CallNextHookEx(plHooking, nCode, wParam, lParam)     'évidemment là on est obligé de rappeller car tout est mort ,dead ,ralbate ,crevé etc...

Debug.Print "on sort en catastrophe de " & CtrlHooked.Name: Exit Function     ' on sort on va pas boucler sur une erreur ca suffit une fois espece de saucisse!!!!

ErrorCritique:
Debug.Print "erreur critique" & CtrlHooked.Name
MsgBox "Une erreur est survenue pendant hook " & vbCrLf & Err.Description, vbCritical, CtrlHooked.Name
Resume Nettoyage     ' on renvoie au nettoyage pour tout nettoyer et relancer avec callnexthook neccessaire cette fois ci car externe à la partie ou tout se passe bien
End Function

 

[fanch55]

J'ai commenté tous les timers comme toi . Tout fonctionne correctement et sans latence .
Le bout du tunnel semble être là ...

 

[patricktoulon]

re
d'ailleurs autre chose pour être vraiment précis ça serait plutot cça .ListCount - (.ListRows - 1)
tout les dernier items etant inclus dans le listrows ne peuvent pas remonter en topindex 1

Case TypeOf CtrlHooked Is ComboBox Or TypeName(CtrlHooked) = "ComboBox"
                    On Error Resume Next
                    If Mdata > 0 _
                    Then .TopIndex = Application.Max(0, .TopIndex - 1) _
                    Else .TopIndex = Application.Min(.TopIndex + 1, .ListCount - (.ListRows - 1))
                    If Err <> 0 Then CtrlHooked.DropDown
                    Err.Clear: On Error GoTo ErrorCritique

on pourrait faire la même chose pour les listbox