XL 2016 Gérer un évènement sur un grand nombre de contrôles de même type d'un UserForm

[Dudu2]

Bonjour,

J'ai 100 TextBoxes dans un UserForm.
Je voudrais gérer soit le _Enter soit le _DblClick sur tous ces contrôles pour y faire quelque chose de commun.
Pour éviter de déclarer 100 fois dans le code du UserForm le même évènement sur chacune des TextBoxes j'aimerais savoir s'il y a un autre possibilité, genre une classe dédiée.
Mais je ne suis pas très expert dans ce domaine et serais reconnaissant pour toute aide apportée sur la méthode.

Ci-joint un fichier avec 1 userForm de 3 TextBoxes comme base pour proposer un code qui ferait un simple MsgBox "Hello" sur un double-clic dans toutes les TextBoxes.
Merci par avance.

 

[patricktoulon]

re
allez petite leçon du jour dis moi pourquoi cette macro est mal conçue

Private Function GetUsfHandle(UsfCaption As String) As Variant
    If Val(Application.Version) < 9 Then
        GetUsfHandle = FindWindow("ThunderXFrame", UsfCaption) 'XL97
    Else
        GetUsfHandle = FindWindow("ThunderDFrame", UsfCaption) 'XL2000
    End If
End Function

 

[Dudu2]

Aucune idée. Dis-moi...
Je sais que si je supprime le Caption du UserForm (ça m'arrive de le faire) je ne retrouve pas le Handle.

Edit: ok je NE peux PAS le remplacer par un GetActiveWindow() car quand il est minimisé, ce n'est plus le bon Handle. Et je NE peux PAS le mémoriser dans la fonction car la fonction est générique et peut s'appliquer à différents UserForms en cours de traitement. Sauf à le mémoriser dans l'appelant, ce qui serait la solution pour un UserForm sans Caption.

 

[patricktoulon]

re
voilà tu a trouvé tout seul
GetActiveWindow !!!!!

 

[Dudu2]

Bonjour la liste,
Ok ok... pour faire plaisir à @patricktoulon, j'ai codé les 2 méthodes pour faire référence au UserForm:
- par Caption
- par Handle
Le choix est déterminé par une constante compilateur.

 

[Dudu2]

Question TRÈS technique...
Lorsqu'on minimise le UserForm il va se placer en bas à gauche de l'écran au-dessus de la barre des tâches, soit dans la zone de status lorsque la fenêtre Excel est maximisée.

Est-ce possible de contrôler son lieu d'atterrissage ?

Je demande ça car j'exploite la zone de status pour afficher des infos que la minimisation vient masquer.

Edit: pour cette raison j'ai dû coder une "minimisation applicative" consistant simplement à positionner le UserForm en bas de la feuille vers le zoom. La minimisation/maximisation applicative étant déclenchée par un OnKey {F3}. Mais ce serait bien de pouvoir contrôler la position système.

 

[patricktoulon]

bon ben on se marre ici
bon allez j'y vais avec mes astuces a la C....
un userform full system menu
sauf que pour le coup ca ne se passe plus dans le bureau mais dans l'application
drôle non?
pour @Dudu2 qui aime les gros roman j'ai pris la peine de déclarer mes api

Option Explicit
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As Long
        Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
    #Else
        Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
        Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
#Else
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Dim oldpos
Private Sub CommandButton1_Click()
    End Sub


Private Sub UserForm_Activate()
    Dim HwnD&, AppHwnD&
    HwnD = GetActiveWindow
    SetWindowLong HwnD, -16, &H94CF8080
    AppHwnD = Application.HwnD
    SetParent HwnD, AppHwnD
oldpos = Array(Me.Left, Me.Top, Me.Width, Me.Height)
End Sub

Private Sub UserForm_Layout()
    If Me.Height > 30 Then oldpos = Array(Me.Left, Me.Top, Me.Width, Me.Height)
End Sub

Private Sub UserForm_Resize()
    With Me
        If .Height < 30 Then
            Me.Move Application.Width - .Width, Application.Height - .Height - 6, 100, Me.Height
            ElseIf .Height = oldpos(3) Then .Move oldpos(0), oldpos(1), oldpos(2), oldpos(3)
            ElseIf .Height > oldpos(3) Then
        End If
    End With
End Sub

je résume le principe
le userform devient enfant de l'application et non du desktop
on lui ajoute les bouton
on se sert du resize pour détecté quand on le reduit agrandi ou normal
le layout c'est pour re mémoriser sa new position quand on le bouge avec la souris

résultat on a le même comportement sauf que ça se passe au niveau de l'application
il ne peut pas sortir de l'application excel
et quand il est réduit il est a droite

LOL!!!

 

[Dudu2]

@patricktoulon, merci. Je ne sais pas d'où tu sors tout ça mais rien ne te résiste ! J'en reste coi !
Je vais essayer ton code.

 

[Dudu2]

Ton code fonctionne, pas de souci.
Par contre je n'arrive pas à déterminer par la suite qui est le parent du UserForm.
J'ai besoin de le savoir pour calculer la position soit par rapport à Excel soit par rapport à l'écran.

Quand que je fait un GetParent(UsfHandle) avant et après le SetParent UsfHandle, Application.hwnd) j'ai toujours la même chose: Application.Hwnd.
C'est comme si le Parent avait toujours été le Application.Hwnd.

Quand je fais un IsChild(Application.hwnd, UsfHandle) j'ai toujours 0 que le SetParent ait été fait ou pas.

Declare PtrSafe Function IsChild Lib "user32" (ByVal hWndParent As LongPtr, ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

 

[patricktoulon]

re
le parent c'est bien l'application
l'api ischild est bancale c'est bien connu

c'est le top 0 du userform c'est le top de l'application
il ne peut plus sortir de ce périmètre

 

[patricktoulon]

si tu veux travailler avec le userform enfant de 0(getdesktopwindow)c'est facile
tu bloque la ligne set parent
et tu ajoute a la ligne move le left et le top de l'application
résultat meme comportement mais le userform tu peux le bouger en dehors de l'application

Option Explicit
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As Long
        Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
    #Else
        Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
        Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
#Else
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Dim oldpos
Private Sub CommandButton1_Click()
    End Sub


Private Sub UserForm_Activate()
    Dim HwnD&, AppHwnD&
    HwnD = GetActiveWindow
    SetWindowLong HwnD, -16, &H94CF8080
    AppHwnD = Application.HwnD
   ' SetParent HwnD, AppHwnD
oldpos = Array(Me.Left, Me.Top, Me.Width, Me.Height)
End Sub

Private Sub UserForm_Layout()
    If Me.Height > 30 Then oldpos = Array(Me.Left, Me.Top, Me.Width, Me.Height)
End Sub

Private Sub UserForm_Resize()
    With Me
        If .Height < 30 Then
            Me.Move Application.Left + (Application.Width - .Width), Application.Top + (Application.Height - .Height - 6), 100, Me.Height
            ElseIf .Height = oldpos(3) Then .Move oldpos(0), oldpos(1), oldpos(2), oldpos(3)
            ElseIf .Height > oldpos(3) Then
        End If
    End With
End Sub

 

[Dudu2]

Bon, n'ayant pu trouver qui est le Parent du UserForm par un moyen API, j'ai géré une variable.
De toutes façon, dans la méthode Handle il faut gérer une variable Handle, donc une de plus ça ne gène pas.

Dans le fichier suivant j'ai utilisé ta méthode (que je connaissais déjà) pour faire de la fenêtre Excel le Parent du UserForm. Par contre je n'ai pas utilisé les évènements _Resize() et Layout() du UserForm.

J'ai fait le Move directement dans la fonction de Minimize avec comme paramètres:
- un ratio de Shift horizontal (par rapport à la gauche de la fenêtre du Parent)
- un ratio de Shift vertical (par rapport au haut de la fenêtre du Parent)
Ça permet de sortir du UserForm des fonctions pour les concentrer dans la Module "utilitaire".

Il y a donc 2 minimisations possibles:
- Par rapport à la fenêtre Excel (le Parent est l'application Excel)
- Par rapport à l'écran (le Parent est le Desktop)

 

[patricktoulon]

re
et oui la gestion des fenêtre mdi depuis office 2010 a tout changé
du coup comme je disais plus haut (pour ischild) , il y a beaucoup d'api windows qui sont obsolètes

 

[Dudu2]

Bonjour @patricktoulon,
Oui, faut contourner.
J'ai modifié le fichier ci-dessus pour calculer la hauteur de la barre des tâches au lieu de la mettre en constante.
En supposant qu'elle est en bas de l'écran, 99,99% des cas. J'ai bien des fonctions pour en déterminer le RECT mais je ne veux pas complexifier ces fonctions inutilement

 

[patricktoulon]

tu veux faire quoi exactement
réduire dans la barre des taches ?
réduire a droite de la barre des taches?
réduire a droite de l'application ?

 

[Dudu2]

Je veux plus rien faire, je suis arrivé à mes fins, c'est à dire minimiser où je veux, que le UserForm soit lié à Excel ou pas. Pour cela j'utilise 2 paramètres optionnels dans la fonction de minimisation qui permettent d'ajuster par un ratio (de 0 à 1 comme un curseur virtuel) la position horizontale et la position verticale dans la fenêtre parente.