Adapter petit code dans module de classe

Version imprimable

1 pièce(s) jointe(s)

Bonjour a toutes et tous, Forum bonjour

Je reviens vers vous a propos de mon module de classe qui fonctionne mais je n'arrive pas a adapter le bout de code a traiter.

Je ne vois plus comment faire après pleins d'essais et vous sollicite svp pour une aide.

Je m'explique:
A l’ouverture de l’UserForm tous les labels 0/9 à Z sont Violet >> Label 100 à 126 et tous les labels en dessous en Rose >> Label 127 à 153.
Si la souris n’ai plus dans un de ces labels alors retour à couleur Violet et Rose

But :

Au survol de la souris des labels 100 à 126 passent en Rouge puis reprends la couleur Violet quand on le quitte
et les labels dessous suivent le mouvement, mais la couleur change en Turquoise, comme voir svp Photo.

Je joins une photo plus simple qu'un long discours.

Je vous remercie pour temps et votre aide et vous souhaitent une très bonne journée.

Cordialement Ray
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 Dans Module de Classe baptisé ClasseLabels Option Explicit Public WithEvents GrLabels As Msforms.Label Public Gest As Gestion_du_listing 'Nom de l'UserForm Private Sub GrLabels_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim i As Integer Set Gest = Gestion_du_listing ‘------------- Pour repartir de ce Code original ci-dessous Private Sub Label100_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) For i = 100 To 126 With Me If .Controls("Label" & i).Name = "Label100" Then .Controls("Label" & i).BackColor = RGB(255, 0, 0) 'Rouge .Controls("Label" & i + 27).BackColor = &HFFFF80 'Turquoise If .Controls("Label" & i + 27).Caption <> "" Then .TextBox3.Value = .Controls("Label" & i).Caption & " : " & .Controls("Label" & i + 27).Caption Else .TextBox3.Value = "" End If Else If .Controls("Label" & i).BackColor <> &H800080 And _ .Controls("Label" & i + 27).BackColor <> &HC0C0FF Then .Controls("Label" & i).BackColor = &H800080 'Violet .Controls("Label" & i + 27).BackColor = &HC0C0FF 'Rose End If End If End With Next i End Sub Dans Module UserFrom Initialize: Dim Btn(100 To 126) As New ClasseLabels Dim i As Integer '##### USERFORM INITIALIZE Private Sub UserForm_Initialize() For i = 100 To 126 Set Btn(i).GrLabels = Me("Label" & i) Next i End Sub

Salut !
Puis-je me permettre de te proposer une approche plus "propre" ?

D'abord, retiens qu'une classe devrait être "autonome"
Le fait que tu crées une classe qui fasse référence à un objet de classe existant (ton userform), c'est très moyen.
Ensuite, pourquoi ne considèrerais-tu pas le couple de tes deux labels à mettre en forme comme un objet, et donc, tu pourrais créer une classe pour un couple. Et une autre classe collection de tes couples.

Tu aurais ainsi une classe myControl (pour le couple):

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
Option Explicit
Public WithEvents Titre     As MSForms.Label    'Etiquette dont on suit le survol
Public Valeur               As MSForms.Label    'Etiquette associée
Public Parent               As myControls       'Définition de la classe parente (myControls)
'Définition de la liste des couleurs
Public Enum myeColors
    myeColorROSE = &HC0C0FF
    myeColorROUGE = 255
    myeColorTURQUOISE = &HFFFF80
    myeColorVIOLET = &H800080
End Enum
Public Sub INIT()
'---------------------------------------------------------------------------------------
' Procedure : INIT
' Author    : mhubiche
' Date      : 13/11/2012
' Purpose   : Initialisation des contrôles à leurs valeurs d'origine
'---------------------------------------------------------------------------------------
'
    Titre.BackColor = myeColorVIOLET
    Valeur.BackColor = myeColorROSE
End Sub
Private Sub Titre_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'---------------------------------------------------------------------------------------
' Procedure : Titre_MouseMove
' Author    : mhubiche
' Date      : 13/11/2012
' Purpose   : Procédure qui se déclenche à chaque survol de la souris d'une étiquette
'               surveillée
'---------------------------------------------------------------------------------------
'
    On Error GoTo Titre_MouseMove_Error
    Me.Parent.PreviousCouple.INIT           'réinitialiser, si possible, l'étiquette parente (err 91 si échouage)
    Titre.BackColor = myeColorROUGE         'mettre le rouge en haut
    Valeur.BackColor = myeColorTURQUOISE    'mettre le turquoise en bas
    Set Me.Parent.PreviousCouple = Me       'indiquer que ce myControl est le "précédent" du future survol
    On Error GoTo 0
    Exit Sub                                'sortir de la procédure
Titre_MouseMove_Error:
    Select Case Err.Number
        Case 91                             'l'objet n'a pas été initialisé
            Resume Next                     'continuer comme si de rien n'était
        Case Else                           'sinon, afficher le message d'erreur
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Titre_MouseMove of Module de classe myControl"
    End Select
End Sub

Pour ce qui est de la classe "collection", tu pourrais avoir dans une classe myControls, un code du genre :

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
Option Explicit
Private m_oColl             As Collection     'collection de couples
Private m_oPreviousCouple   As myControl      'Stockage temporaire du dernier couple touché par le survol de la souris
Private Sub Class_Initialize()
'Création de la collection à l'instanciation de l'objet
    Set m_oColl = New Collection
End Sub
Private Sub Class_Terminate()
'Destruction de la collection et de l'objet précédent à la destruction de l'objet
    Set m_oColl = Nothing
    Set m_objPreviousCouple = Nothing
End Sub
 
Function Add(a_oLabel1 As MSForms.Label, a_oLabel2 As MSForms.Label) As myControl
'---------------------------------------------------------------------------------------
' Procedure : Add
' Author    : mhubiche
' Date      : 13/11/2012
' Purpose   : Procédure qui crée un objet couple et le stocke dans la collection
' Parameters:
'       a_oLabel1 = objet Label supérieur
'       a_oLabel2 = objet Label inférieur
'---------------------------------------------------------------------------------------
'
    Dim oTemp               As myControl
    Set oTemp = New myControl
    Set oTemp.Titre = a_oLabel1             'définition du label supérieur
    Set oTemp.Valeur = a_oLabel2            'définition du label inférieur
    Set oTemp.Parent = Me                   'définition de cet objet comme "parent" du couple créé
    oTemp.INIT                              'initialiser le contrôle
    m_oColl.Add oTemp                       'ajout à la collection
    Set Add = oTemp                         '(facultatif, mais je suis parti sur une fonction... alors...
End Function
 
Sub Reinit()
'---------------------------------------------------------------------------------------
' Procedure : Reinit
' Author    : mhubiche
' Date      : 13/11/2012
' Purpose   : Procédure pour la réinitialisation totale des contrôles survolés
'---------------------------------------------------------------------------------------
'
    Dim i                   As Long
    For i = 1 To m_oColl.Count
        m_oColl.Item(i).INIT
    Next
End Sub
 
Public Property Get PreviousCouple() As myControl
'Propriété de "stockage" du dernier Couple survolé
    Set PreviousCouple = m_oPreviousCouple
End Property
Public Property Set PreviousCouple(a_oPreviousCouple As myControl)
    Set m_oPreviousCouple = a_oPreviousCouple
End Property

Et, pour finir, il te sufirait d'avoir ce code dans ton formulaire :

Code:

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
Private m_oClasse As myControls
Private Sub UserForm_Initialize()
    Set m_oClasse = New myControls
    m_oClasse.Add Me.Label1, Me.Label2
    m_oClasse.Add Me.Label3, Me.Label4
    m_oClasse.Add Me.Label5, Me.Label6
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    m_oClasse.Reinit
End Sub

Bien sûr, tu pourrais remplacer les Label1, 2, ... par les bons noms :)
++

13/11/2012, 12h18
eliot.raymond

Salut Maxence

Merci pour avoir lu mon post et pour ta réponse

j'ai regarder attentivement le code proposé, mais hélas je ne suis pas du plus balèze en VBA je me débrouille avec ce que je sais, mais là pour être franchement honnête ça me dépasse complètement.

Désolé, d'ailleurs j'aurai dù le dire

j'aurai préféré svp un code plus simple pour résoudre mon souci, car en fait c'est juste pour une gestion de vidéos que j'améliore, étant en retraite ça passe le temps et j'aime bien la programmation.

En tout cas, je te remercie de m'avoir fait partager ton savoir.

Bon app, encore merci et bonne après midi

Cordialement Ray

Une autre proposition qui nécessite une préparation préalable:
Pour chaque Label d'en haut, mettre dans sa Tag le nom du Label d'en bas correspondant
Pour les autres labels, laisser leur Tag vide

1. Dans un module de classe nomé MaClasse

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
Public WithEvents MyLabel As MSForms.Label
 
Private Sub MyLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
With MyLabel.Parent
    If MyLabel.BackColor <> mRouge Then
        MyLabel.BackColor = mRouge
        .Controls(MyLabel.Tag).BackColor = mTURQUOISE
        .TextBox3.Value = MyLabel.Caption & " : " & .Controls(MyLabel.Tag).Caption
    End If
    If Titre <> MyLabel.Name Then
        If Titre <> "" Then
            .Controls(Titre).BackColor = mVIOLET
            .Controls(Valeur).BackColor = mROSE
        End If
        Titre = MyLabel.Name
        Valeur = .Controls(MyLabel.Tag).Name
    End If
End With
End Sub

2. Dans un module standard

Code:

1
2
3
4
5
6
7
8
Option Explicit
 
Public Titre As String
Public Valeur As String
Public Const mROSE As Long = &HC0C0FF
Public Const mROUGE As Long = 255
Public Const mTURQUOISE As Long = &HFFFF80
Public Const mVIOLET As Long = &H800080

3. Dans le module de l'userform

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
Option Explicit
 
Dim TbLabels() As New MaClasse
 
Private Sub UserForm_Initialize()
Dim k As Byte
Dim Ctrl As Control
 
For Each Ctrl In Me.Controls
    If TypeOf Ctrl Is MSForms.Label Then
        If Ctrl.Tag <> "" Then
            k = k + 1
            Ctrl.BackColor = mVIOLET
            Me.Controls(Ctrl.Tag).BackColor = mROSE
            ReDim Preserve TbLabels(1 To k)
            Set TbLabels(k).MyLabel = Ctrl
        End If
    End If
Next Ctrl
End Sub
 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
If Titre <> "" Then
    Me.Controls(Titre).BackColor = mVIOLET
    Me.Controls(Valeur).BackColor = mROSE
    Me.TextBox3.Value = ""
    Titre = ""
    Valeur = ""
End If
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 
Erase TbLabels
End Sub

13/11/2012, 13h05
Maxence HUBICHE

RE ! :)

Ne t'en fais pas pour ça !
Fais-toi 2 modules de classe
Nommes les myControl et myControls
Dans myControl , copie le 1er exemple de code
Dans myControls, copie le 2ème exemple de code

Dans ton formulaire, fais les modifications que je t'ai proposé dans le 3ème exemple de code
et... ça marche !!!
Fais des essais, ca marche tout seul !
Pense quand même à mettre les bons labels , dans le code du formulaire, sur les lignes que j'ai écrit ainsi :

Code:

m_oClasse.Add Me.Label1, Me.Label2

Où Label1 est l'étiquette du haut (0/9 => Z) , et Label2 est l'étiquette du bas (100 => 126)
:) :) :)

Après, si tu veux découvrir ce qui se passe dans le code - comment il fonctionne - tu peux mettre un point d'arrêt (F9) sur une ligne (par exemple "Private Sub UserForm_Initialize()" dans ton formulaire)
Ouvres alors ton formulaire, et regarde ce qui se passe, en faisant avancer le programme avec la touche F8

Bon courage !
;)

@mercatog

Dommage l'arrivée du module standard, ainsi que l'apparition de tout ce code dans le formulaire !!!
L'idée intéressante que je retiens, c'est celle du tag
Ainsi, le tag pourrait récupéré dynamiquement dans l'exemple de code que j'ai donné au-dessus pour référencer le label au moment de l'usage de la méthode Add de myControls

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function Add(a_oLabel1 As MSForms.Label,) As myControl
'---------------------------------------------------------------------------------------
' Procedure : Add
' Author    : mhubiche
' Date      : 13/11/2012
' Purpose   : Procédure qui crée un objet couple et le stocke dans la collection
' Parameters:
'       a_oLabel1 = objet Label supérieur
'---------------------------------------------------------------------------------------
'
    Dim oTemp               As myControl
  Dim oLabel               As MSForms.Label
    Set oTemp = New myControl
    Set oTemp.Titre = a_oLabel1             'définition du label supérieur
  Set oLabel = a_oLabel1.Parent.Controls(a_oLabel1.Tag)
    Set oTemp.Valeur = oLabel            'définition du label inférieur
    Set oTemp.Parent = Me                   'définition de cet objet comme "parent" du couple créé
    oTemp.INIT                              'initialiser le contrôle
    m_oColl.Add oTemp                       'ajout à la collection
    Set Add = oTemp                         '(facultatif, mais je suis parti sur une fonction... alors...
End Function

Bon... OK, une petite gestion d'erreur pourrait être un plus... :)

Et, du coup, on n'aurait plus besoin de faire un passage

Code:

1
2
 
m_oClasse.Add Me.Label1, Me.Label2

mais

Code:

m_oClasse.Add Me.Label1

suffirait
et ce serait la seule réelle modification à faire dans tout le code...

13/11/2012, 13h33
eliot.raymond

Salut Mercatog

Merci pour la nouvelle proposition, c'est sympa

juste un renseignement svp pour m'éclairer un peu, je ne sais pas faire la manipulation que tu me dis

Si et si j'ai bien compris il faut assembler le label du haut avec celui du bas afin de n'en faire qu'un donc plus facile a piloter un que deux humm non

moi qui voulait du simple c'est pas gagné :roll:

Citation:

Une autre proposition qui nécessite une préparation préalable:
Pour chaque Label d'en haut, mettre dans sa Tag le nom du Label d'en bas correspondant
Pour les autres labels, laisser leur Tag vide

bon je vais essayer tout ca merci a vous

Ray
13/11/2012, 14h27
mercatog

@ Maxence HUBICHE
Toujours aussi impressionnant dans vos codes, j'apprends de vous et c'est gratuit ;)
@eliot.raymond
As tu testé d'abord la solution proposé par Maxence?

Pour ma proposition, il faudra d'abords sélectionner chaque label d'en haut et mettre manuellement dans sa propriété Tag le nom du label d'en bas qui lui correspond (clique bouton droit sur ton label ensuite menu contextuel Propriété)

Tu as 27 labels à qui il faudra faire cette manipulation.

Attention quand même, tous les autres labels de ton userform devront avoir un Tag vide.
13/11/2012, 15h42
eliot.raymond

Salut Mercatog

Non, je n'ai pas encore tester le code de Maxence.

Par compte j'ai essayer le tien qui me semblai plus facile pour moi.

Dans la propriété Tag du premier label du haut (Label100) j'ai mis le nom du Label du bas c'est a dire (Label127) et ainsi de suite.

J'ai virer l'ancien module de classe comme écrit dans mon post #1.

Puis adapter ton code a mon programme.

Et je te dit :bravo: et un très grand :merci: pour ton aide, car ça marche impeccablement bien comme je le souhaitai.

maintenant je vais faire une sauvegarde et bidouiller tout ça pour voir comment ça marche en faisant du F8.

Ensuite essai du code de l'ami Maxence que je remercie également

PS:
Pour cette phrase que tu m'adresses, je ne comprends pas trop ou tu veux en venir ????

Le savoir n'a de valeur que si il est partagé et sur ce forum c'est le cas, j'en profite pour remercier tous ceux qui m'on aider.

Voila en tout cas je te remercie de nouveau car ton code me permet de faire le ménage dans mon code.

Bonne fin d'après midi :salut:

Cordialement Ray

PS

Le code du module de classe MaClasse peut être simplifié comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public WithEvents MyLabel As MSForms.Label
 
Private Sub MyLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
With MyLabel.Parent
    If MyLabel.Name <> Titre Then
        MyLabel.BackColor = mROUGE
        .Controls(MyLabel.Tag).BackColor = mTURQUOISE
        .TextBox3.Value = MyLabel.Caption & " : " & .Controls(MyLabel.Tag).Caption
        If Titre <> "" Then
            .Controls(Titre).BackColor = mVIOLET
            .Controls(Valeur).BackColor = mROSE
        End If
        Titre = MyLabel.Name
        Valeur = .Controls(MyLabel.Tag).Name
    End If
End With
End Sub

15/11/2012, 15h13
eliot.raymond

Salut Mercatoq,

Je n'avais pas vu cette modification, je viens de l'essayer et ça fonctionne très bien aussi donc j'ai laisser cette version dans mon programme.

je te remercie c'est vraiment super sympa a toi, a bientôt sans doute, je retourne paufiner le programme.

très bonne après midi a toi et encore merci, et ce n'ai pas de trop :ccool:

bye bye Cordialement Raymond