Discussion :

[eliot.raymond]

Bonjour a toutes et tous, Forum bonjour

Après de multiples essais, je ne parviens pas a faire un module de classe pour le code ci-dessous que je dois répéter 36 fois.

Actuellement ces 36 procédures tournent et fonctionne bien mais afin d'alléger mon programme je souhaiterai faire un Module de classe.

j'en ai pourtant déjà fait mais la je coince

Si quelqu'un veux bien m'aider svp a en créer un nouveau, je vous en remercie par avance.

Je mets juste le code qui doit être traiter par le module de classe, préférable de repartir du début.

Label164 à 174 Label chiffre 0 à 9
Lablel175 à 200 Label lettre A à Z

J'ai 36 codes identiques a celui ci-dessous, juste le N° du Label change.

Merci a vous et de votre temps, bonne après midi.

Cordialement Ray

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub Label164_Click() 'Chiffre 0
Dim a As Integer, Cpt As Integer
For Each Ctrl In Me.Frame4.Controls
If TypeOf Ctrl Is msforms.Label Then
If Ctrl.Name = "Label164" Then
Ctrl.Object.BackColor = RGB(0, 255, 0)
Else
If IsNumeric(Ctrl.Object.Caption) Then
Ctrl.Object.BackColor = &H80C0FF         'Beige
Else
Ctrl.Object.BackColor = &HFFC0FF         'Rose
End If
End If
End If
Next Ctrl
 
Temp = Me.Label164.Caption
nbFilm = [ListeFilms].Count
Me.ListView2.ListItems.Clear      'Suppression anciens éléments
 
For I = 1 To nbFilm
If UCase(Left(Range("ListeFilms")(I), Len(Temp))) = UCase(Temp) Then
Cpt = Cpt + 1
End If
Next
 
If Cpt = 0 Then Me.Label203.Caption = "Aucune vidéo trouvée": Exit Sub
ReDim tablo(1 To Cpt, 0)
I = 1
Do While I <= Cpt
a = a + 1
If UCase(Left(Range("ListeFilms")(a), Len(Temp))) = UCase(Temp) Then
tablo(I, 0) = Range("ListeFilms")(a)
I = I + 1
End If
Loop
 
With Me.ListView2
.ColumnHeaders.Clear            'Supprime anciennes entêtes
.HideColumnHeaders = True    'On cache entêtes
.ColumnHeaders.Add , , "Nom du film", .Width - 20
.CheckBoxes = True
 
'* Boucle sur les fichiers du dossier cible
For I = 1 To UBound(tablo)       'Vérifie s'il s'agit d'un sous dossier non pris en compte
.ListItems.Add , , tablo(I, 0): Cpt = 0      'Ajoute 1 ligne
Set fs = CreateObject("Scripting.FileSystemObject")
Set Dossier = fs.GetFolder("E:\Affiche")
Cpt = 0
For Each f In Dossier.Files
If f.Name = tablo(I, 0) & ".jpg" Then Cpt = 1
Next
If Cpt = 0 Then .ListItems(I).ForeColor = RGB(255, 0, 0)    'Rouge
Next I
End With
End Sub

[kiki29]

Salut, cela pourrait peut-être t'aider ?

[eliot.raymond]

Salut kiki29, forum

Merci de ta réponse, déjà parcouru le site pour lecture

Pas réussi a faire malgré la lecture recommandé et des recherches sur le net

je vais encore chercher comment faire

merci bonne fin d'après midi

Cdtl Ray

[Daniel.C]

Bonjour,
Essaie d'adapter le code du classeur joint (merci Isabelle):

Dans le module de classe (MesLabels) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Public WithEvents Lbl As MSForms.Label
 
Private Sub Lbl_Click()
    MsgBox Lbl.Caption
End Sub

Dans le module de l'userform :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Dim GrLabels() As New MesLabels
Private Sub UserForm_Activate()
Dim c As Control, i As Integer
For Each c In Me.Controls
    If Left(c.Name, 5) = "Label" Then
        ReDim Preserve GrLabels(i)
        Set GrLabels(i).Lbl = c
        i = i + 1
    End If
Next
End Sub

A toi d'adapter (je n'ai pas trop cherché à comprendre ce que tu voulais faire). N'hésite pas si tu as des questions.

[eliot.raymond]

Salut Daniel

Merci pour ta réponse, je vais essayer le code proposer

pour infos: en fait j'ai un userform avec 36 Labels et pour EX: lorsque je clic
dans le label 175 lettre A, j'ai la liste des vidéos qui commence par la lettre choisie
ça évite de passer toute la liste en revue, bien plus rapide donc je voulais
arranger un peu le code qui est lourd avec ces répètitions, voili voila


Label164 à 174 Label chiffre 0 à 9
Lablel175 à 200 Label lettre A à Z

Merci bonne soirée a plus tard

Cdlt Ray

Re salut Daniel

Bon j'ai fait l'essai avec ton code cela fonctionne pas d'erreur mais ca m'affiche uniquement le N° du Label dans lequel je clique

Ca ne m'affiche pas la liste des vidéos commençant par la lettre choisie

en tout cas déjà merci pour ça

Bonne soirée bon app

Cdlt Ray

[Daniel.C]

Oui, comme je l'ai dit, je n'ai pas cherché à comprendre la logique de ton code. Toi qui la connaît, il te suffit de remplacer le "MsgBox" par le code qui va bien

[kiki29]

Salut, à titre documentaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Option Explicit
 
'   Sous VBE Menu Outils/Références
'   Cocher Microsoft Forms 2.0 Object Library
'
'   ou Parcourir et sélectionner c:\windows\system32\FM20.dll
'   ou Créer une UserForm puis la supprimer
 
Sub Création()
Dim UsfForm As Object
Dim Btn As MSForms.CommandButton
Dim Lbl As MSForms.Label
Dim i As Long, j As Long
Dim UsfName As String
Dim iLeft As Long, iTop As Long
Dim L As Double, T As Double
Dim Pas As Double
 
    Application.VBE.MainWindow.Visible = False
    Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)
    With UsfForm
        .Properties("Caption") = "USF et Labels Dynamiques"
        .Properties("Width") = 240
        .Properties("Height") = 200
    End With
    UsfName = UsfForm.Name
 
    Set Btn = UsfForm.Designer.Controls.Add("Forms.CommandButton.1")
    With Btn
        .Height = 28
        .Width = 60
        .Left = 90
        .Top = 140
        .Caption = "Quitter"
    End With
 
    iLeft = 10: iTop = 10
    For i = 1 To 10
        Set Lbl = UsfForm.Designer.Controls.Add("Forms.Label.1", , True)
        With Lbl
            .Width = 20
            .Height = 20
            .Left = iLeft
            .Top = iTop
            .BorderStyle = fmBorderStyleSingle
            .SpecialEffect = fmSpecialEffectFlat
            .TextAlign = fmTextAlignCenter
            .Caption = i - 1
            .Font.Bold = True
            .Font.Size = 16
            .BackColor = &HC0E0FF
            .Tag = i - 1
        End With
        iLeft = iLeft + 22
    Next i
 
    iTop = iTop + 22
    iLeft = 10
    Pas = 2
    For i = 0 To 25
        Set Lbl = UsfForm.Designer.Controls.Add("Forms.Label.1", , True)
        With Lbl
            .Width = 20
            .Height = 20
            L = (i Mod 10) * (.Width + Pas)
            T = (i \ 10) * (.Height + Pas)
            .Left = L + iLeft
            .Top = T + iTop
            .BorderStyle = fmBorderStyleSingle
            .SpecialEffect = fmSpecialEffectFlat
            .Font.Bold = True
            .Font.Size = 16
            .TextAlign = fmTextAlignCenter
            .Caption = Chr(i + 65)
            .BackColor = &HC0FFFF
            .Tag = i + 65
        End With
    Next i
 
    With UsfForm.CodeModule
        i = .CountOfLines
        If i = 2 Then
            .InsertLines i, "": i = i + 1
        Else
            i = 1
        End If
 
        .InsertLines i, "Private Sub CommandButton1_Click()": i = i + 1
        .InsertLines i, "    Unload Me": i = i + 1
        .InsertLines i, "End Sub": i = i + 1
 
        For j = 1 To 36
            .InsertLines i, "": i = i + 1
            .InsertLines i, "Private Sub Label" & j & "_Click()": i = i + 1
            .InsertLines i, "   MsgBox Label" & j & ".Tag": i = i + 1
            .InsertLines i, "End Sub": i = i + 1
        Next j
    End With
 
    VBA.UserForms.Add(UsfName).Show
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UsfForm
End Sub

[eliot.raymond]

Bonjour kiki29, bonjour forum

Merci pour le code, c'est gentil, j'ai fait de nouveaux essais mais sans résultat

ça plante pas mais je dois mal coder le bout de programme que je souhaite
faire fonctionner.

Toutefois une question si tu veux bien:

Dans le cas d'un module de classe, c'est important le bout de code
qu'il soit dans UserForm_initialise () où dans UserForm_Activate ()

c'est quoi la différence ??? svp


Bonne journée cdlt Ray

Oui, comme je l'ai dit, je n'ai pas cherché à comprendre la logique de ton code. Toi qui la connaît, il te suffit de remplacer le "MsgBox" par le code qui va bien

Salut Daniel

Merci pour ta réponse bon je n'arrive pas faire fonctionner comme je l'ai dit également a l'ami kiki29

merci de votre aide, je vais essayer de comprendre pourquoi je n'arrive pas

bonne journée Cdlt Ray

[Daniel.C]

Ca pourrait peut-être donner ça (en remplaçant "Me" par le nom de l'userform) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Lbl_Click()
Dim a As Integer, Cpt As Integer
 
Lbl.BackColor = RGB(0, 255, 0)
 
Temp = Lbl.Caption
nbFilm = [ListeFilms].Count
Me.ListView2.ListItems.Clear      'Suppression anciens éléments
 
For i = 1 To nbFilm
    If UCase(Left(Range("ListeFilms")(i), Len(Temp))) = UCase(Temp) Then
        Cpt = Cpt + 1
    End If
Next
 
If Cpt = 0 Then Me.Label203.Caption = "Aucune vidéo trouvée": Exit Sub
ReDim tablo(1 To Cpt, 0)
i = 1
Do While i <= Cpt
    a = a + 1
    If UCase(Left(Range("ListeFilms")(a), Len(Temp))) = UCase(Temp) Then
        tablo(i, 0) = Range("ListeFilms")(a)
        i = i + 1
    End If
Loop
 
With Me.ListView2
    .ColumnHeaders.Clear            'Supprime anciennes entêtes
    .HideColumnHeaders = True    'On cache entêtes
    .ColumnHeaders.Add , , "Nom du film", .Width - 20
    .CheckBoxes = True
 
    '* Boucle sur les fichiers du dossier cible
    For i = 1 To UBound(tablo)       'Vérifie s'il s'agit d'un sous dossier non pris en compte
        .ListItems.Add , , tablo(i, 0): Cpt = 0      'Ajoute 1 ligne
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set Dossier = fs.GetFolder("E:\Affiche")
        Cpt = 0
        For Each f In Dossier.Files
            If f.Name = tablo(i, 0) & ".jpg" Then Cpt = 1
        Next
        If Cpt = 0 Then .ListItems(i).ForeColor = RGB(255, 0, 0)    'Rouge
    Next i
End With
End Sub

[kiki29]

Salut, concernant les évènements, voir Utiliser les UserForm en VBA Excel
Ma solution proposée, à titre documentaire, ne comporte pas de module de classe.

[Theze]

Bonjour,

A mettre dans un module de classe nommé "Classe1" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Public WithEvents GroupeLbl As MSForms.Label
 
 
Private Sub GroupeLbl_Click()
 
    Film GroupeLbl
 
End Sub

A mettre dans le module de ta Form ce doit être sur "Initialize" et non "Activate" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Dim Lbl() As New Classe1
 
Private Sub UserForm_Initialize()
 
    Dim Ctrl As Control
    Dim I As Integer
 
    For Each Ctrl In Me.Controls
 
        If TypeName(Ctrl) = "Label" Then
 
            I = I + 1
            ReDim Preserve Lbl(1 To I)
            Set Lbl(I).GroupeLbl = Ctrl
 
        End If
 
    Next Ctrl
 
    Set Ctrl = Nothing
 
End Sub

A mettre dans un module standard. C'est ta proc mais je ne l'ai pas testée en plein (pas envie de créer un classeur avec tout le toutim :o( ) alors il te faut adapter à fur et à mesure des bugs qui vont se présenter. Ici la Form s'appelle "UserForm1" donc adapte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Film(Intitule As MSForms.Label) 'Chiffre 0
 
    Dim Tablo() As String
    Dim Ctrl As Control
    Dim fs As Object
    Dim Dossier As Object
    Dim I As Integer
    Dim Cpt As Integer
    Dim nbFilm As Integer
    Dim Temp As String
 
    'défini les fonds des différents Labels
    For Each Ctrl In UserForm1.Controls
 
        If TypeName(Ctrl) = "Label" Then
 
            If IsNumeric(Ctrl.Caption) Then
 
                Ctrl.BackColor = &H80C0FF         'Beige
 
            Else
 
                Ctrl.BackColor = &HFFC0FF         'Rose
 
            End If
 
        End If
 
    Next Ctrl
 
    'défini le Label actif
    Intitule.BackColor = RGB(0, 255, 0)
 
    Temp = Intitule.Caption
 
    nbFilm = [ListeFilms].Count
 
    UserForm1.ListView2.ListItems.Clear      'Suppression anciens éléments
 
    For I = 1 To nbFilm
 
        If UCase(Left(Range("ListeFilms")(I), Len(Intitule.Caption))) = UCase(Intitule.Caption) Then
 
            Cpt = Cpt + 1
            ReDim Preserve Tablo(1 To Cpt)
            Tablo(Cpt, 0) = Range("ListeFilms")(I)
 
        End If
 
    Next
 
    If Cpt = 0 Then UserForm1.Label203.Caption = "Aucune vidéo trouvée": Exit Sub
 
    With UserForm1.ListView2
 
        .ColumnHeaders.Clear            'Supprime anciennes entêtes
        .HideColumnHeaders = True    'On cache entêtes
        .ColumnHeaders.Add , , "Nom du film", .Width - 20
        .CheckBoxes = True
 
        '* Boucle sur les fichiers du dossier cible
        For I = 1 To UBound(Tablo)       'Vérifie s'il s'agit d'un sous dossier non pris en compte
 
            .ListItems.Add , , Tablo(I)    'Ajoute 1 ligne
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set Dossier = fs.GetFolder("E:\Affiche")
            Cpt = 0
 
            For Each f In Dossier.Files
 
                If f.Name = Tablo(I, 0) & ".jpg" Then Cpt = 1 'ils sont sensé exister puisqu'ils sont dans la liste, non ?
 
            Next
 
            If Cpt = 0 Then .ListItems(I).ForeColor = RGB(255, 0, 0)    'Rouge
 
        Next I
 
    End With
 
End Sub

Hervé.

[eliot.raymond]

Salut Daniel et Hervé

j'ai bien regarder vos codes et imprimer, je passe a l'action maintenant, je vais essayer de comprendre comment ça marche.

je vous remercie tout deux de votre aide, vous souhaitent une bonne après midi

c'est parti a plus tard je vous tient au courant

Cordialement Ray

[eliot.raymond]

Bonjour a tous, forum bonjour

Des nouvelles du module de classe, hé bien, c'est bon, j'ai eu beaucoup de mal

mais j'y suis parvenu, gràce a vous.

Kiki29, Thèze (Hervé), Daniel, je vous remercie tous les trois pour votre

savoir et votre précieuse aide et également pour votre patience.

Pour ce même programme, je dois faire un autre module de classe.

Question svp : est-il possible d'ajouter un autre module ou pas baptiser d'un autre nom bien sur ??? merci

j'attends la réponse et je clos le sujet

Encore merci a vous bon W-end a tous

Cordialement Raymond

[Theze]

Bonjour,

Bien sûr que tu peux en ajouter un autre !

Hervé.

[eliot.raymond]

Ok merci pour la réponse, bon app

a bientot sans doute

je clos ce sujet

encore merci bye bye