VBA - Scroll en Controls ActiveX & UserForm (ListBox, ComboBox, TextBox, UserForm, Frame, MultiPage) V16

[Dudu2]

Deuxième problème: la TextBox ActiveX.
1 - Si je sors de la TextBox et scrolle la feuille et reviens sur la TexBox, il faut que je clique pour ré-activer le Scroll.
Ça je dois pouvoir le régler en activant la TextBox à chaque Scroll.

2 - Si je sors de la TextBox et sélectionne une cellule, même en cliquant sur la TexBox, je ne peux pas ré-activer son Scroll (l'évènement ne se déclenche pas) sauf à fermer son IC en passant sur une autre Control.
Je pourrais mettre en place un système pour parer à ça mais ça ne vaut pas le coup de complexifier le bidule pour le Scroll en TextBox ActiveX.

Conclusion: je reste en l'état pour la version InkCollector en excluant TexBox ActiveX. Je vais juste améliorer la TextBox UserForm.

 

[Dudu2]

Voilà j'ai publié la V3 du fichier en Post #97.

Elle corrige le bug du Scroll TextBox UserForm qui continue lorsque le curseur sort de la TextBox dans une zone non soumise au Scroll.
Le GetwindowRect() sur le Handle de la TextBox obtenu par WindowFromPoint() est tout simplement faux et représente le RECT de son Parent. Il a donc fallu aller chercher le RECT de la TextBox par examen interne du UserForm avec la fonction GetUserFormControlRECT().

De plus elle supprime la gestion du Scroll sur les Controls ActiveX car cela se bloque lorsqu'on scrolle sur la feuille et il n'y a pas moyen de détecter la situation de blocage.

 

[jurassic pork]

Deuxième problème: la TextBox ActiveX.
1 - Si je sors de la TextBox et scrolle la feuille et reviens sur la TexBox, il faut que je clique pour ré-activer le Scroll.
Ça je dois pouvoir le régler en activant la TextBox à chaque Scroll.

2 - Si je sors de la TextBox et sélectionne une cellule, même en cliquant sur la TexBox, je ne peux pas ré-activer son Scroll (l'évènement ne se déclenche pas) sauf à fermer son IC en passant sur une autre Control.
Je pourrais mettre en place un système pour parer à ça mais ça ne vaut pas le coup de complexifier le bidule pour le Scroll en TextBox ActiveX.

Conclusion: je reste en l'état pour la version InkCollector en excluant TexBox ActiveX. Je vais juste améliorer la TextBox UserForm.

Dudu2 il ne faut jamais désespérer , il y a une solution simple au problème de scroll de la feuille quand on scrolle dans un contrôle ActiveX :

'----------
'MouseWheel
'----------
Private Sub IC_MouseWheel(ByVal Button As MSINKAUTLib.InkMouseButton, ByVal Shift As MSINKAUTLib.InkShiftKeyModifierFlags, ByVal Delta As Long, ByVal x As Long, ByVal y As Long, Cancel As Boolean)
    Call Scroll(CurrentControl, Keep_ScrollLines, Delta > 0)
    Cancel = True
End Sub

En mettant Cancel à True on empêche le Scroll de se propager à la feuille

 

[Dudu2]

Bonjour @jurassic pork ,
C'est bien vu et plus "carré" que ma méthode sur le ScrollArea basée sur un OnTime.
Cependant, les Controls ActiveX posent d'autres problèmes que j'ai noté dans le fichier joint.

Si seulement l'évènement IC_CursorOutOfRRange() fonctionnait, ça solutionnerait tous les problèmes. Hélas....

Edit: Pour faire fonctionner l'évènement IC_CursorOutOfRRange(), il faut placer la souris très précisément en bordure du Control.
Et encore ça ne fonctionne pas sur les bordures droites et basses ! Même en précisant .MarginX et .MarginY.
C'est donc un évènement parfaitement inutile !

 

[jurassic pork]

Bonjour @jurassic pork ,
C'est bien vu et plus "carré" que ma méthode sur le ScrollArea basée sur un OnTime.
Cependant, les Controls ActiveX posent d'autres problèmes que j'ai noté dans le fichier joint.

Si seulement l'évènement IC_CursorOutOfRRange() fonctionnait, ça solutionnerait tous les problèmes. Hélas....

Edit: Pour faire fonctionner l'évènement IC_CursorOutOfRRange(), il faut placer la souris très précisément en bordure du Control.
Et encore ça ne fonctionne pas sur les bordures droites et basses ! Même en précisant .MarginX et .MarginY.
C'est donc un évènement parfaitement inutile !

Hello,
je vérifie
Ami calmant, J.P

 

[jurassic pork]

je vérifie

Quand cela bloque si tu cliques dans la textbox, cela refonctionne

 

[Dudu2]

Quand cela bloque si tu cliques dans la textbox, cela refonctionne

Certes, clic dans la TextBox après Scroll feuille ok, mais comme je l'ai écrit, si sélection cellule, ça bloque définitivement.

 

[jurassic pork]

Certes, clic dans la TextBox après Scroll feuille ok, mais comme je l'ai écrit, si sélection cellule, ça bloque définitivement.

Regarde la pièce jointe 1215945

ben non pas chez moi, dès que je survole un autre contrôle que celui qui est bloqué cela me débloque TOUJOURS la situation (événements CURSOR supprimés).
Je n'arrive pas à avoir un blocage permanent.

 

[Dudu2]

ben non pas chez moi, dès que je survole un autre contrôle que celui qui est bloqué cela me débloque TOUJOURS la situation

Ah oui évidemment, mais c'est "tricher" que de survoler un autre Control car ça ré-initialise le processus.
Les blocages décrits impliquent de ne pas activer le Scroll d'un autre Control.
Si tu n'as qu'une ListBox dans la feuille, comment tu fais ?

Et bien voilà comment tu fais...
J'ai mis en place un petit mécanisme dont la vocation est de palier l'incapacité de l'évènement IC_CursorOutOfRange() à détecter la sortie d'un Control en profitant du fait que je suis passé par un Module avant d'aller sur la Classe car ça ne peut pas être codé en Classe.

L'idée est de "débrancher" l'IC si le curseur n'est plus sur sa zone, car le dernier IC activé le reste indéfiniment ce qui n'est pas génial.
Ce n'est pas la panacée mais ça fonctionne pour ActiveX et UserForm.

Edit: Pour les TextBoxes (ActiveX ou UserForm) je ne peux hélas pas récupérer leur RECT avec les API car le RECT rendu est celui du Parent.
Il a donc fallu que j'inclue mes fonctions de récupération de RECT GetActiveXControlRECT() et GetUserFormControlRECT() pour les TextBox.
Du coup, puisque présentes, je les ai utilisées pour tous les Controls (ActiveX ou UserForm).

 

[jurassic pork]

L'InkCollector peut détecter quand la souris quitte sa zone en utilisant le TrackMouseEvent fonction. Cette fonction affiche des messages lorsque le pointeur de la souris quitte une fenêtre ou survole une fenêtre pendant une durée spécifiée.3 Pour détecter quand la souris quitte InkCollector, vous devez appeler TrackMouseEvent avec les paramètres appropriés pour demander le suivi des congés de la souris. Lorsque la souris quitte la zone client de la fenêtre spécifiée dans l'appel à TrackMouseEvent, la fenêtre reçoit un WM_MOUSELEAVE message.8 Ce message indique que la souris a quitté la zone client et annule tout suivi demandé par TrackMouseEvent. L'application doit appeler TrackMouseEvent encore une fois lorsque la souris rentre dans sa fenêtre si elle nécessite un suivi supplémentaire du comportement de survol de la souris.

 

[Dudu2]

La fonction TrackMouseEvent() peut être intéressante à exploiter. Même si ça ressemble à du... "hooking".
Elle a besoin d'un Handle et je suppose que pour les TextBoxes, leur Handle utilisé en GetWindowRECT qui rend le RECT du Parent va avoir le même impact sur TrackMouseEvent().
Faut que je trouve un exemple en VBA.

 

[jurassic pork]

Faut que je trouve un exemple en VBA.

cherche pas trop longtemps finalement je crois que cette piste n'est pas facilement (et même) faisable en VBA.

 

[Dudu2]

Justement j'ai cherché et trouvé des trucs incompréhensibles, à part peut-être cette page.
Mais je rame à essayer d'implémenter, je ne comprends pas comment récupérer le message.
Je fatigue et laisse tomber.

Un embryon de code.

Private Const WM_MOUSELEAVE = &H2A3&
Private Const WM_MOUSEMOVE = &H200
Private Const TME_LEAVE = &H2&

#If VBA7 Then
    Private Type TRACKMOUSEEVENTTYPE
        cbSize As Long
        dwFlags As Long
        hwndTrack As LongPtr
        dwHoverTime As Long
    End Type
#Else
    Private Type TRACKMOUSEEVENTTYPE
        cbSize As Long
        dwFlags As Long
        hwndTrack As Long
        dwHoverTime As Long
    End Type
#End If

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As LongPtr
#Else
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
    Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
#End If

Private Const GWL_WNDPROC = (-4)
Private Const WM_NCDESTROY = &H82
'Private Const TME_LEAVE = &H2&

Sub a()
    #If VBA7 Then
        Dim hwnd As LongPtr
    #Else
        Dim hwnd As Long
    #End If
    Dim TME As TRACKMOUSEEVENTTYPE
    
    Call WindowFromAccessibleObject(ActiveSheet.ListBox1, hwnd)
    
    TME.cbSize = 16
    TME.dwFlags = TME_LEAVE
    'TME.dwHoverTime = trak.HoverTime
    TME.hwndTrack = hwnd
    Call TrackMouseEvent(TME)
    
    Call SetWindowLongPtr(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

 

[jurassic pork]

Je fatigue et laisse tomber.

J'ai peut-être une solution pas très compliquée :
tu englobles tes contrôles dans un controle image transparent et tu testes le mousemove de l'image :

 

[Dudu2]

Ok, mais c'est fait pour être utilisé par n'importe qui, donc ça n'est pas possible d'imposer une image par dessus.
Sinon, la méthode que j'ai utilisée dans le fichier du Post #97 n'est pas si mauvaise.

De toutes façons, pour le Scroll générique ActiveX et UserForm il y a le traditionnel Hooking (pour moi la référence), sinon on peut se rabattre sur le InkCollector déjà publié en Post #97.