Collection module classe 2024 patricktoulon (classe controls) gérer Enter/exit TextBox 1.0 1.0

[patricktoulon]

faut si tu libère la classe qui les abritent elle serons détruites set cl=nothing kill toutes les instance liées à cl car elle fon parti de sa portées mais je préfère les killer dans terminate!

faux cls a une portée globale module et non public

 

[dysorthographie]

re
robert tu a raison pour le erase du cls
@Dudu2 je pige rien de ce que tu me dis

et non si je met les instances de classe dans une collection le fait de mettre la collection à nothing ne détruit pas les instance de classe

mets un point d'arrêt sur terminate et tu verra que toutes les instance sont effacé avec set collection=nothing

globale ,public ou privé c'est pareil la mise = nothing libère l'instance et ses dépendence mais je le répète je préfère éradiquer les sous clase dans la méthode terminate

de toutes les façons si tu à mis erase dans termintate plus de problème

 

[patricktoulon]

re

 

[Dudu2]

J'ai "monté" la table des instances de classe dans le UserForm et j'ai bien autant d'Initialize() dans le traitement que de Terminate() à la fermeture du UserForm sans avoir besoin de faire quoique ce soit (il y a des traces à mettre par constante préprocesseur pour le vérifier).

Je n'ai pas fait de référence croisée entre les instances (genre set Instance2.InitialInstance = Instance1 que j'avais au début pour placer et référencer dans 1 seule instance les données communes) pour que les instances soient libres de se terminer sans dépendance. C'est possible grâce au fait que la table des instances de classe est dans le UserForm, c.a.d. à l'extérieur de la classe. Donc je peux référencer la classe initiale qui stocke les données communes via le UserForm sans avoir à la déclarer et valoriser dans les autres instances de classe.

C'est très laborieux car la table des instances de classe dans le UserForm doit être un Variant et dans la Classe on a du mal à adresser des variables d'instances de cette table (Excel plante avec une erreur incompréhensible de Property Let ou Get) et il faut passer par des variables intermédiaires. Mais une fois ce problème étrange contourné, ça passe.

J'essaierais volontiers une Collection mais je suis moins à l'aise qu'avec une table et je ne sais pas trop comment associer un item en Add et en Retrieve avec une Instance de classe. Je vais essayer plus tard.

La ressource contient maintenant la nouvelle version du code.

 

[dysorthographie]

désolé Patrick je n'aurais j'aimais du intervenir , j'ai craché dans ta soupe et je n'aurais pas du je suis vraiment désolé. nous n'avons pas la même façon de développer et comme je n'est pas tenté de résoudre le problème que tu as admirablement relevé je suis ma placé pour commenter.

encor n fois désolé, ça ne ce produira plus.

 

[patricktoulon]

re
Bonjour à tout les deux
non robert c'est moi qui m'excuse j’étais mal luné hier la fatigue

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'             Collection Module classe  by patricktoulon
'Classe de gestion de pseudo events Enter et Exit pour les textbox
'version 4.0
'date version:20/04/2024
''**************************************************************************************************
Option Explicit
Public WithEvents TxtBox As MSForms.TextBox
Public WithEvents bouton As MSForms.CommandButton
Public WithEvents opt As MSForms.OptionButton
Public WithEvents Check As MSForms.CheckBox
Public WithEvents toggle As MSForms.ToggleButton
Public WithEvents LstBox As MSForms.ListBox
Public WithEvents Combo As MSForms.ComboBox
Public WithEvents Image As MSForms.Image
Public WithEvents spin As MSForms.SpinButton
Public WithEvents multi As MSForms.MultiPage
Public WithEvents fram As MSForms.frame
Public WithEvents forme As UserForm
Public WithEvents lsView As ListView
Public memoire As TxtBoxEnterExit
Public usf As Object
Public oldcontrol 'As Control
Public AllClass As New Collection
Public nam As String
Function init(usf)
    Dim cls() As New TxtBoxEnterExit
    Dim CtrL, A&, first
    Me.nam = "mère"
    For Each CtrL In usf.Controls
        If TypeOf CtrL Is TextBox Or TypeName(CtrL) = "TextBox" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).TxtBox = CtrL: CtrL.Value = CtrL.Name
        If TypeOf CtrL Is OptionButton Or TypeName(CtrL) = "OptionButton" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).opt = CtrL
        If TypeOf CtrL Is CommandButton Or TypeName(CtrL) = "CommandButton" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).bouton = CtrL
        If TypeOf CtrL Is CheckBox Or TypeName(CtrL) = "CheckBox" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).Check = CtrL
        If TypeOf CtrL Is ToggleButton Or TypeName(CtrL) = "ToggleButton" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).toggle = CtrL
        If TypeOf CtrL Is ListBox Or TypeName(CtrL) = "ListBox" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).LstBox = CtrL
        If TypeOf CtrL Is ComboBox Or TypeName(CtrL) = "Combobox" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).Combo = CtrL
        If TypeOf CtrL Is Image Or TypeName(CtrL) = "Image" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).Image = CtrL
        If TypeOf CtrL Is frame Or TypeName(CtrL) = "Frame" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).fram = CtrL
        If TypeOf CtrL Is SpinButton Or TypeName(CtrL) = "SpinButton" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).spin = CtrL
        If TypeOf CtrL Is MultiPage Or TypeName(CtrL) = "multipage" Then A = A + 1: ReDim Preserve cls(1 To A): Set cls(A).multi = CtrL
        cls(A).nam = CtrL.Name
        Set cls(A).forme = usf
        Set cls(A).memoire = Me
        If A = 1 Then
            Set first = usf.Controls(0)
            If TypeName(first) = "Frame" Then Set first = first.Controls(0)
            If TypeName(first) = "MultiPage" Then Set first = first.Pages(first.Value).Controls(0)
            Set cls(A).memoire.oldcontrol = first
        End If
        AllClass.Add cls(A)
    Next
    Erase cls
End Function

Private Sub Class_Terminate()
    MsgBox "classe " & Me.nam & " terminée"
End Sub

Private Sub resultat()
    Dim ControlIn, ControlOut

    Set ControlIn = forme.ActiveControl
    Set ControlOut = memoire.oldcontrol
    'Déviation d'affiliation pour les controls eventuellement placés dans une frame ou multipage
    If TypeName(ControlIn) = "Frame" Then Set ControlIn = ControlIn.ActiveControl
    If TypeName(ControlIn) = "MultiPage" Then Set ControlIn = ControlIn.Pages(ControlIn.Value).ActiveControl

    'envoie aux pseudo events
    If ControlIn.Name <> ControlOut.Name Then
        If TypeName(ControlOut) = "TextBox" Then Control_Exit forme.Controls(ControlOut.Name)
        If TypeName(ControlIn) = "TextBox" Then Control_Enter forme.Controls(ControlIn.Name)
    End If
    'on met a jour oldcontrol avec le control actif pour le prochain tour
    Set memoire.oldcontrol = ControlIn

End Sub

Private Sub Class_Initialize()

End Sub


'les event key_down
'Private Sub TxtBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = TxtBox: End Select: End Sub
'Private Sub Opt_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = opt: End Select: End Sub
'Private Sub bouton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = bouton: End Select: End Sub
'Private Sub Check_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = Check: End Select: End Sub
'Private Sub Toggle_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = toggle: End Select: End Sub
'Private Sub LstBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = LstBox: End Select: End Sub
'Private Sub Combo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = Combo: End Select: End Sub
'Private Sub image_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): Select Case KeyCode: Case 9, 13: Set memoire.oldcontrol = Image: End Select: End Sub

'les events key_Up
Private Sub TxtBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub opt_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub bouton_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub Combo_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub LstBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub image_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub toggle_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub Check_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub spin_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): resultat: End Sub
Private Sub LsView_KeyUp(KeyCode As Integer, ByVal Shift As Integer): resultat: End Sub

'les events mouse_Down
Private Sub bouton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub opt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub TxtBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub LstBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub Combo_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub toggle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub Check_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub image_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub Multi_MouseDown(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub fram_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): resultat: End Sub
Private Sub LsView_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS): resultat: End Sub
Private Sub Spin_SpinDown(): resultat: End Sub
Private Sub Spin_SpinUp(): resultat: End Sub

'les faux events Exit et Enter
Sub Control_Enter(ctrlY)

    Cells(Rows.Count, 1).End(xlUp).Offset(1) = " Enter : " & ctrlY.Name
End Sub
Sub Control_Exit(ctrlX)

    Cells(Rows.Count, 1).End(xlUp).Offset(1) = " Exit : " & ctrlX.Name
End Sub

dans le userform

Dim cl As New TxtBoxEnterExit


Private Sub CommandButton2_Click()
'Set cl = Nothing se ferme réellement uniquement si les instance child de cl ont été fermé auparavant
'Set cl.AllClass = Nothing 'ferme les instance child
End Sub

Private Sub UserForm_Initialize()
cl.init Me 'dans le intialise ou activate de l'userform
End Sub

Autrement dit si vous voulez tout fermer a la fermture du userform il vous suffit de supprimer les child s dans le queryclose de l'userform

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set cl.AllClass = Nothing 'ferme les instance child
End Sub

j'espère que cette demo vidéo sans equivoque vous apportera quelques eclaircissements

 

[Dudu2]

Bonjour les Classieux du VBA,

Alors j'ai vérifié ton code et ça fonctionne.

 

[patricktoulon]

re ok @Dudu2
comme tu la vu j'utilise une collection
et dans la vidéo je montre a deux reprises qu' un set cl=nothing non seulement ne ferme pas la classe cl mais ne ferme pas non plus les classes childs
contrairement à ce que l'on pourrait croire

dans un autre contexte; peu être!!!!
comme dans certains exemples de classe de ma collection tutorielle de module classe
qui gère des events existants dans les classes( je parles des events implémentés)

ça nous ramène a ta précédente question du a un de tes trous de mémoire(selon tes dires)
je te le rappelle

Bonjour @patrcktoulon,
Est-ce que tu peux me rappeler pourquoi dans la classe on n'utilise pas directement les évènements Enter() et Exit() ? Je suis un peu perdu sur ce truc.

pour résumer
si les events n'existent pas et que tu les crée de toute pièce (comme c'est la cas présent)
il te faudra killer les classes childs

 

[Dudu2]

Pour ma part, dans la dernière version, j'ai réussi à garder les données communes dans l'instance de classe déclarée dans le UserForm qui contient des informations de contexte et la table des instances des Controls. De sorte qu'aucune instance de Control ne fait référence à une autre et il n'y a que l'instance du UserForm qui contient la table de toutes les autres.

A la fermeture du UserForm, toutes les instances sont terminées automatiquement. Pas besoin d'un Call en Query_Close().

Tu pourrais appliquer la même méthode en utilisant l'instance de ton UserForm Me.form.cl (puisque tu propages le form sur toutes les instances des Controls) à la place de ta "mémoire". A condition évidemment de déclarer cl comme Public.

Edit:

et dans la vidéo je montre a deux reprises qu' un set cl=nothing non seulement ne ferme pas la classe cl mais ne ferme pas non plus les classes childs
contrairement à ce que l'on pourrait croire

Je pense que si ton Set cl = Nothing ne fontionne pas c'est parce que cl fait référence à une autre instance qui n'est pas terminée. J'ai fait des tests avec Classe = Nothing et ça termine bien l'instance de classe.

 

[patricktoulon]

re

1°

Je pense que si ton Set cl = Nothing ne fontionne pas c'est parce que cl fait référence à une autre instance qui n'est pas terminée.

dans ma méthode les instance sont bien des childs de cl aussi


2°

J'ai fait des tests avec Classe = Nothing et ça termine bien l'instance de classe.

??????????????????

 

[Dudu2]

et dans la vidéo je montre a deux reprises qu' un set cl=nothing non seulement ne ferme pas la classe cl mais ne ferme pas non plus les classes childs
contrairement à ce que l'on pourrait croire

J'ai fait des tests avec Classe = Nothing et ça termine bien l'instance de classe.

??????????????????

Essaie ce classeur...

 

[Dudu2]

Par opposition une Classe = Nothing qui ne termine pas l'instance parce l'instance est référencée dans une autre instance, ce qui est le cas de ton code sur les Enter/Exit à cause de ta "mémoire" je suppose.