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