Transformer plusieurs sub en module de classe

**Garlim** · 13/12/2016, 11h47

Bonjour,

J'ai énormément de sub qui se ressemble à une valeur près.
Je voudrais savoir s'il est possible de transformer tout cela en un module de classe et une fonction?

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Private Sub FOTextBox1_Change()
    If UserForm1.APLabel211.Caption = "décol" Then Exit Sub
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 4).Value = FOTextBox1.Text    'Poste niv 0
End Sub
 
Private Sub FOTextBox2_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 5).Value = FOTextBox2.Text    'Nom niv 0
End Sub
 
Private Sub FOTextBox3_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 6).Value = "'" & FOTextBox3.Text    'Tel niv 0
End Sub
 
Private Sub FOTextBox4_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 7).Value = FOTextBox4.Text    'email niv 0
End Sub
 
Private Sub FOTextBox5_Change()
    If UserForm1.APLabel211.Caption = "décol" Then Exit Sub
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 8).Value = FOTextBox5.Text    'Poste niv 1
End Sub
 
Private Sub FOTextBox6_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 9).Value = FOTextBox6.Text    'Nom niv 1
End Sub
 
Private Sub FOTextBox7_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 10).Value = "'" & FOTextBox7.Text    'Tel niv 1
End Sub
 
Private Sub FOTextBox8_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 11).Value = FOTextBox8.Text    'email niv 1
End Sub
 
Private Sub FOTextBox9_Change()
    If UserForm1.APLabel211.Caption = "décol" Then Exit Sub
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 12).Value = FOTextBox9.Text    'Poste niv 2
End Sub
 
Private Sub FOTextBox10_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 13).Value = FOTextBox10.Text    'Nom niv 2
End Sub
 
Private Sub FOTextBox11_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 14).Value = "'" & FOTextBox11.Text    'Tel niv 2
End Sub
 
Private Sub FOTextBox12_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 15).Value = FOTextBox12.Text    'email niv 2
End Sub
 
Private Sub FOTextBox13_Change()
    If UserForm1.APLabel211.Caption = "décol" Then Exit Sub
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 16).Value = FOTextBox13.Text    'Poste niv 3
End Sub
 
Private Sub FOTextBox14_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 17).Value = FOTextBox14.Text    'Nom niv 3
End Sub
 
Private Sub FOTextBox15_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 18).Value = "'" & FOTextBox15.Text    'Tel niv 3
End Sub
 
Private Sub FOTextBox16_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 19).Value = FOTextBox16.Text    'email niv 3
End Sub
 
Private Sub FOTextBox17_Change()
    If UserForm1.APLabel211.Caption = "décol" Then Exit Sub
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 20).Value = FOTextBox17.Text    'Poste niv 4
End Sub
 
Private Sub FOTextBox18_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 21).Value = FOTextBox18.Text    'Nom niv 4
End Sub
 
Private Sub FOTextBox19_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 22).Value = "'" & FOTextBox19.Text    'Tel niv 4
End Sub
 
Private Sub FOTextBox20_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 23).Value = FOTextBox20.Text    'email niv 4
End Sub
 
Private Sub FOTextBox21_Change()
    If UserForm1.APLabel211.Caption = "décol" Then Exit Sub
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 24).Value = FOTextBox21.Text    'Poste niv 5
End Sub
 
Private Sub FOTextBox22_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 25).Value = FOTextBox22.Text    'Nom niv 5
End Sub
 
Private Sub FOTextBox23_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 26).Value = "'" & FOTextBox23.Text    'Tel niv 5
End Sub
 
Private Sub FOTextBox24_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 27).Value = FOTextBox24.Text    'email niv 5
End Sub
 
Private Sub FOTextBox25_Change()
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Range("A1:AE" & Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row & "").AutoFilter Field:=1, Criteria1:="*" & UserForm1.FOLabel36.Caption & "*", Operator:=xlFilterValues
    Workbooks(UserForm1.AcLabel8.Caption).Sheets("Fournisseur").Cells(Sheets("Fournisseur").Cells(65536, 1).End(xlUp).Row, 29).Value = FOTextBox25.Text    'parma atlas
End Sub

J'ai également ce problème sur des Frames (je cherche à ce qu'au survol de la souris de n'importe quelle frame, le label1 devienne vide) :

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
Private Sub APFRame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame7_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame8_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame9_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame10_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame18_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame19_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame20_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""
End Sub
 
Private Sub APFRame25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = ""

Pourriez-vous m'aider à réduire mon code sachant que le Userform pèse 131,5Kb et qu'il faut le passer sous les 64 Kb pour éviter les plantages à l'ouverture?

J'ai cherché sur d'autres sur pas mal de forum, de sites, mais je n'ai jamais réussir à obtenir une solution pour mes 2 cas.
Merci par avance.

Garlim

Transformer plusieurs sub en module de classe

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager