Boucle sur des frames (module de classe)

Version imprimable

Bonjour à vous
je voudrais boucler sur des frames pour pouvoir utiliser l'évènement Label_MouseMove de chaque label.
j'ai un userform sur lequel se trouvent plusieurs frames et labels. mais je voudrais déclencher les évènements des labels se trouvant dans les frames spécifiques.

Dans un module de classe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Explicit

Public WithEvents Frm As MSForms.Frame
Public WithEvents Lbel As MSForms.Label

Dim Cls() As New ClsCouleur
Dim Ctls As Control

Function ChangerCouleur(ByRef Usf As Object)
Dim i As Integer, j As Integer, Obj As Object
    For j = 90 To 95
        i = i + 1
        ReDim Preserve Cls(1 To i)
        Set Obj = Usf("Frame" & j)
        Set Cls(i).Frm = Obj
    Next
End Function

Function ChangerCouleur2(ByRef Usf As Object)
Dim i As Integer, j As Integer, Obj As Object

    For Each Ctls In Usf.Controls
        i = i + 1
        ReDim Preserve Cls(1 To i)
        Select Case TypeName(Ctls)
            Case "Label"
            Set Cls(i).Lbel = Ctls
        End Select
    Next Ctls
End Function


Function PasdeCouleur(ByRef Uf As Object)
    For Each Ctls In Uf.Frm.Controls
        If TypeOf Ctls Is MSForms.Label Then
            Ctls.ForeColor = vbWhite
            Ctls.SpecialEffect = fmSpecialEffectFlat
        End If
    Next
    
End Function

Function CouleurLabel(ByVal Uf As Object)
Dim i As Integer, ObjFrame As Control, j As Integer

    For i = 90 To 95
    j = j + 1
        
        Set ObjFrame = Uf("Frame" & i)
        For Each Ctls In Uf.ObjFrame.Controls
            If TypeOf Ctls Is MSForms.Label Then
                 Ctls.ForeColor = &HFFFF&
                Ctls.SpecialEffect = fmSpecialEffectEtched
            End If
        Next
    Next
End Function


Private Sub Frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
PasdeCouleur Me
End Sub

Private Sub Lbel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

 CouleurLabel Me
End Sub


	Code:
	
123  
 
Module de l'userform
Option Explicit

Dim ChgCouleur As New ClsCouleur, ChgCouleur2 As New ClsCouleur

Private Sub UserForm_Initialize()

ChgCouleur.ChangerCouleur Me
ChgCouleur2.ChangerCouleur2 Me
End Sub

lors de l'exécution Set ObjFrame = Uf("Frame" & i) cette partie du code est surligné. message: propriété ou méthode non gérée par cet objet

veuillez m'aider svp

26/02/2023, 15h46
joe.levrai

Bonjour,

il faut utiliser la propriété Controls

Code:

Uf.Controls("Frame" & j)
26/02/2023, 20h15
Mr l'Ashanti

Merci de ta réponse mais toujours le même message.

Code:

Set ObjFrame = Uf.Controls("Frame" & i)
27/02/2023, 01h02
deedolith
@Joe:
Heu, ce machin, ça ne fonctionne que si les frames s'appellent Fram1, Frame2, Frame3 ect ect ... rien n'est moins vrai !!

@Mr l'Ashanti:
Si tu veux boucler sur toutes les frames, tu n'as pas 36 choix, il te faut boucler sur tous les contrôles et filtrer.
Exemple:
Code:

1 2 3 4 5 6 Dim Ctrl As MSForms.Control For Each Ctrl In Me.Controls If TypeOf Ctrl Is MSForms.Frame Then '// faire quelque chose End If Next
27/02/2023, 02h50
Mr l'Ashanti

Merci
Effectivement, j'ai plusieurs frames et plusieurs labels dispersés sur l'userform et j'ai renommé les frames qui me serviront d'échange ( frame 90 à 95).
Donc je voudrais que lorsque le curseur survolant le label, il change de couleur et lorsqu'il fait de même sur le frame, on annule la mise en forme du label.
La première idée marche nettement et ça se trouve dans la procédure function pasdecouleur.
27/02/2023, 09h00
joe.levrai

Citation:

Envoyé par deedolith

@Joe:
Heu, ce machin, ça ne fonctionne que si les frames s'appellent Fram1, Frame2, Frame3 ect ect ... rien n'est moins vrai !!

Personne n'a dis le contraire ...

j'ai apporté une réponse pratique à son erreur d'écriture
27/02/2023, 10h36
Mr l'Ashanti

Merci à vous pour les réponses...
Mais toujours le même message. Je me demande si ce n'est pas parce que nous sommes dans un module de classe ? Car le code fonctionne très bien ailleurs.
27/02/2023, 19h18
deedolith

Citation:

Envoyé par Mr l'Ashanti

Je me demande si ce n'est pas parce que nous sommes dans un module de classe ?

Rien à voir.
A mon avis, puisque tu concatène une chaîne pour former un nom, et référencer les contrôles par leur nom, tu dois construire un nom qui n'existe pas.

Citation:

Envoyé par deedolith

Rien à voir.
A mon avis, puisque tu concatène une chaîne pour former un nom, et référencer les contrôles par leur nom, tu dois construire un nom qui n'existe pas.

effectivement mais du moment où je crée l'objet avec l'accesseur Set, ça devrait passer non? mais bon... j'ai beaucoup à apprendre des modules de classes et des objets.
j'ai contourné le problème en numérotant les labels et ça marche. voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Option Explicit
Public WithEvents ObjLabel As MSForms.Label
Public WithEvents ObjFrame As MSForms.Frame
 
'***********************************************
Dim ClsTablo() As New ClsObjets
Dim Obj As Object
 
Function Initialisation(ByRef Usf As Object)
Dim i As Integer, J As Integer
 
    For i = 90 To 95
        J = J + 1
        ReDim Preserve ClsTablo(1 To J)
        Set Obj = Usf("Frame" & i)
        Set ClsTablo(J).ObjFrame = Obj
 
    Next
 
    For i = 500 To 517
        J = J + 1
        ReDim Preserve ClsTablo(1 To J)
        Set Obj = Usf("Label" & i)
        Set ClsTablo(J).ObjLabel = Obj
 
    Next
 
End Function
 
Function ChangeCouleur(ByRef Usf As Object)
Dim CtrlLabel As Object
    For Each CtrlLabel In Usf.ObjFrame.Controls
        If TypeOf CtrlLabel Is MSForms.Label Then
            CtrlLabel.ForeColor = vbWhite
            CtrlLabel.SpecialEffect = fmSpecialEffectFlat
            CtrlLabel.Font.Bold = False
            CtrlLabel.Font.Size = 10
        End If
    Next
End Function
 
Private Sub ObjFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ChangeCouleur Me
End Sub
 
 
Private Sub ObjLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ObjLabel.SpecialEffect = fmSpecialEffectEtched
ObjLabel.Font.Bold = True
ObjLabel.ForeColor = &HFFFF&
ObjLabel.Font.Size = 8
End Sub

Ben non, pas obligé, les noms que tu construit par code ne sont aucunement liés au designer.
Si tu construit un nom qui n'existe pas, l'instruction set plante.

Il vaut mieux parcourir ta liste de contrôles et tester les noms (la tu es 100% certain que les contrôles existent).
Ou vérifier l'éxistance du contrôle via une petite fonction utilitaire:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Public Function ExistInCollection(ByVal Key As String, ByRef Col As Object) As Boolean
    ExistInCollection = ExistInCollectionByVal(Key, Col) Or ExistInCollectionByRef(Key, Col)
End Function
 
Private Function ExistInCollectionByVal(ByVal Key As String, ByRef Col As Object) As Boolean
On Error Goto Error
    Dim Item As Variant
    Item = Col(Key)
    ExistInCollectionByVal = True
Exit Function
Error:
    ExistInCollectionByVal = False
End Function
 
Private Function ExistInCollectionByRef(ByVal Key As String, ByRef Col As Object) As Boolean
On Error Goto Error
    Dim Item As Variant
    Set Item = Col(Key)
    ExistInCollectionByRef = True
Exit Function
Error:
    ExistInCollectionByRef = False
End Function

Usage:

Code:

1
2
3
If(ExistInCollection("maFrame", Me.Controls)
    '// Faire quelque chose
End If

28/02/2023, 16h48
Mr l'Ashanti

Vu que le module de classe doit être portatif, est ce nécessaire de connaître les noms des contrôles ?
La problématique est que Set Obj=uf("Frame" &i) fonctionne quand il s'agit de l'initialisation du module de classe dans la fonction initialisation mais dès que nous voulons le considérer comme une collection qui contient les labels, cela ne marche pas.
Je vais continuer à étudier encore sur ça .
Merci infiniment à vous
28/02/2023, 19h29
Valtrase

Salut,
Il y a quelques temps sur un autre forum j'ai posé une question qui s'apparente à ta demande j'ai eu quelques réponses, cela pourras peut-être t'aider
https://forum.excel-pratique.com/exc...mulaire-170655

Pour ma part j'ai toujours pas trouvé un code qui me plaise.
28/02/2023, 20h33
Mr l'Ashanti

Citation:

Envoyé par Valtrase

Salut,
Il y a quelques temps sur un autre forum j'ai posé une question qui s'apparente à ta demande j'ai eu quelques réponses, cela pourras peut-être t'aider
https://forum.excel-pratique.com/exc...mulaire-170655

Pour ma part j'ai toujours pas trouvé un code qui me plaise.

j'ai regardé votre fichier et j'ai été bluffé par le design. concernant le besoin je vais regarder de plus près pour en tirer de meilleures idées.
01/03/2023, 01h15
deedolith

J'ai oublié de relever ce détail, tu violes la Loi de Demeter.
Une classe n'est pas supposé connaitre la moindre chose provenant du formulaire (et surtout pas le nom des contrôles).

Soit les fonctions doivent être privées au formulaire, soit tu revoit ton design.
En l'ocurence, c'est au formulaire de fournir les contrôles que la classe est supposée piloter.
01/03/2023, 07h52
Mr l'Ashanti

Citation:

Envoyé par deedolith

J'ai oublié de relever ce détail, tu violes la Loi de Demeter.
Une classe n'est pas supposé connaitre la moindre chose provenant du formulaire (et surtout pas le nom des contrôles).

Soit les fonctions doivent être privées au formulaire, soit tu revoit ton design.
En l'ocurence, c'est au formulaire de fournir les contrôles que la classe est supposée piloter.

je m'en doutais... c'est évidemment ce dont j'ai voulu survoler mais ma notion des modules de classe est restreinte. je tiendrai compte de vos conseils et les apports.
merci à vous