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