Bonjour,
J'ai remarqué il y a peu de temps un problème dans mon projet.
J'ai un userfom pour ajouter des information , son code:
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157 Private Sub UserForm_Activate() If Nouveau = True Then TextBox15 = WorksheetFunction.Max(Feuil1.Range("B2:B100000")) + 1 End Sub Private Sub TextBox4_Change() Dim Valeur As Byte TextBox4.MaxLength = 10 'nb caractères maxi autorisé dans le textbox Valeur = Len(TextBox4) If Valeur = 2 Or Valeur = 5 Then TextBox4 = TextBox4 & "/" End Sub 'Pour les types Private Sub UserForm_Initialize() Dim J As Long Dim I As Integer ComboBox3.ColumnCount = 1 ComboBox2.List() = Array("", "CAEN", "ANGERS", "LE MANS", "TOURS", "POITIERS", "NANTES", "RENNES", "BREST", "BORDEAUX", "CHARTRES") ComboBox3.List() = Array("", "DIAGNOSTIC", "MISE EN SERVICE", "VISITE", "SERVICE 0") ComboBox4.List() = Array("", "TERMINE", "EN COURS") ComboBox5.List() = Array("", "ANNULE", "FABRICANT", "OK") ComboBox6.List() = Array("", "XXX") End Sub 'Pour le bouton Quitter Private Sub CommandButton3_Click() Unload Me End Sub 'Pour le bouton Nouveau contact Private Sub CommandButton1_Click() Dim L As Integer If MsgBox("Confirmez-vous l'ajout de ce nouveau suivi ?", vbYesNo, "Demande de confirmation dajout") = vbYes Then L = Sheets("RECAPITULATIF").Range("B65536").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide Range("A" & L).Value = Label17 Range("C" & L).Value = ComboBox2 Range("D" & L).Value = TextBox5 Range("E" & L).Value = TextBox1 Range("F" & L).Value = ComboBox6 Range("G" & L).Value = TextBox7 Range("H" & L).Value = TextBox2 Range("I" & L).Value = TextBox3 Range("R" & L).Value = TextBox16 Range("K" & L).Value = ComboBox4 Range("L" & L).Value = ComboBox5 Range("M" & L).Value = TextBox11 Range("N" & L).Value = ComboBox3 Range("O" & L).Value = TextBox12 Range("P" & L).Value = TextBox13 Range("Q" & L).Value = TextBox14 Range("J" & L).Value = TextBox4 Dim Crtl As Control Dim r As Integer Dim t As Integer Dim derligne As Integer With Worksheets("RECAPITULATIF") derligne = .Range("B65536").End(xlUp).Row + 1 For Each Crtl In UserForm1.Controls r = Val(Crtl.Tag) If r > 0 Then Feuil1.Cells(derligne, r) = Crtl Next Feuil1.Cells(derligne, 2) = Val(TextBox15) End With End If Unload Me If Not IsDate(TextBox4) Then MsgBox "Date non-présente ou incorrect" TextBox4 = "" Exit Sub '...la suite de la procédure End If End Sub Sub Macro1() Dim O As Worksheet 'déclare la variable O (Onglet) Dim TC As Variant 'déclare la variabe TC (Tableau de Cellules) Dim NL As Integer 'déclare la varialbe NL (Nombre de Lignes) Dim NC As Integer 'déclare la varialbe NC (Nombre de Colonnes) Dim I As Integer 'déclare la variable I (Incrément) Dim PL As Range 'déclare la varialbe PL (PLage) Set O = Sheets("RECAPITULATIF") 'définit l'onglet O TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellules TC NC = UBound(TC, 2) 'définit le nombre de colonnes NC du tableau de cellules TC Set PL = Range("A1") 'initialise la plage PL For I = 2 To NL 'boucle sur toutes les lignes du tableau de cellules TC If TC(I, 3) = "TOURS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "POITIERS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "LE MANS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "ANGERS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "RENNES" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$B$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "NANTES" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$B$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "BREST" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$B$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "CAEN" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$C$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "CHARTRES" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$D$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "BORDEAUX" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$D$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) End If 'fin de la condition Next I 'prochaine ligne de la boucle If PL.Address <> "$A$1" Then PL.Interior.Color = 5296274 'colore la plage PL de vert If PL.Address <> "$B$1" Then PL.Interior.Color = 12611584 'colore la plage PL de Bleu foncé If PL.Address <> "$C$1" Then PL.Interior.Color = 15773696 'colore la plage PL de Bleu clair If PL.Address <> "$D$1" Then PL.Interior.Color = 49407 'colore la plage PL d'orange End Sub
Mais j'ai un 2eme userfome qui me permet de modifier les information du tableau, il suffit de double clic sur une cellule et celui-ci s'ouvre voici sont code :
Je vous explique mon problème:
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157 Private Sub UserForm_Activate() If Nouveau = True Then TextBox15 = WorksheetFunction.Max(Feuil1.Range("B2:B100000")) + 1 End Sub Private Sub TextBox4_Change() Dim Valeur As Byte TextBox4.MaxLength = 10 'nb caractères maxi autorisé dans le textbox Valeur = Len(TextBox4) If Valeur = 2 Or Valeur = 5 Then TextBox4 = TextBox4 & "/" End Sub 'Pour les types Private Sub UserForm_Initialize() Dim J As Long Dim I As Integer ComboBox3.ColumnCount = 1 ComboBox2.List() = Array("", "CAEN", "ANGERS", "LE MANS", "TOURS", "POITIERS", "NANTES", "RENNES", "BREST", "BORDEAUX", "CHARTRES") ComboBox3.List() = Array("", "DIAGNOSTIC", "MISE EN SERVICE", "VISITE", "SERVICE 0") ComboBox4.List() = Array("", "TERMINE", "EN COURS") ComboBox5.List() = Array("", "ANNULE", "FABRICANT", "OK") ComboBox6.List() = Array("", "XXX ") End Sub 'Pour le bouton Quitter Private Sub CommandButton3_Click() Unload Me End Sub 'Pour le bouton Nouveau contact Private Sub CommandButton1_Click() Dim L As Integer If MsgBox("Confirmez-vous l'ajout de ce nouveau suivi ?", vbYesNo, "Demande de confirmation dajout") = vbYes Then L = Sheets("RECAPITULATIF").Range("B65536").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide Range("A" & L).Value = Label17 Range("C" & L).Value = ComboBox2 Range("D" & L).Value = TextBox5 Range("E" & L).Value = TextBox1 Range("F" & L).Value = ComboBox6 Range("G" & L).Value = TextBox7 Range("H" & L).Value = TextBox2 Range("I" & L).Value = TextBox3 Range("R" & L).Value = TextBox16 Range("K" & L).Value = ComboBox4 Range("L" & L).Value = ComboBox5 Range("M" & L).Value = TextBox11 Range("N" & L).Value = ComboBox3 Range("O" & L).Value = TextBox12 Range("P" & L).Value = TextBox13 Range("Q" & L).Value = TextBox14 Range("J" & L).Value = TextBox4 Dim Crtl As Control Dim r As Integer Dim t As Integer Dim derligne As Integer With Worksheets("RECAPITULATIF") derligne = .Range("B65536").End(xlUp).Row + 1 For Each Crtl In UserForm1.Controls r = Val(Crtl.Tag) If r > 0 Then Feuil1.Cells(derligne, r) = Crtl Next Feuil1.Cells(derligne, 2) = Val(TextBox15) End With End If Unload Me If Not IsDate(TextBox4) Then MsgBox "Date non-présente ou incorrect" TextBox4 = "" Exit Sub '...la suite de la procédure End If End Sub Sub Macro1() Dim O As Worksheet 'déclare la variable O (Onglet) Dim TC As Variant 'déclare la variabe TC (Tableau de Cellules) Dim NL As Integer 'déclare la varialbe NL (Nombre de Lignes) Dim NC As Integer 'déclare la varialbe NC (Nombre de Colonnes) Dim I As Integer 'déclare la variable I (Incrément) Dim PL As Range 'déclare la varialbe PL (PLage) Set O = Sheets("RECAPITULATIF") 'définit l'onglet O TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellules TC NC = UBound(TC, 2) 'définit le nombre de colonnes NC du tableau de cellules TC Set PL = Range("A1") 'initialise la plage PL For I = 2 To NL 'boucle sur toutes les lignes du tableau de cellules TC If TC(I, 3) = "TOURS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "POITIERS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "LE MANS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "ANGERS" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$A$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "RENNES" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$B$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "NANTES" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$B$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "BREST" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$B$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "CAEN" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$C$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "CHARTRES" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$D$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) If TC(I, 3) = "BORDEAUX" Then 'condition : si la valeur en ligne I colonne 3 de TC vaut "TOURS" 'redéfinit la plage PL Set PL = IIf(PL.Address = "$D$1", O.Cells(I, 3).Resize(1, NC - 2), Application.Union(PL, O.Cells(I, 3).Resize(1, NC - 2))) End If 'fin de la condition Next I 'prochaine ligne de la boucle If PL.Address <> "$A$1" Then PL.Interior.Color = 5296274 'colore la plage PL de vert If PL.Address <> "$B$1" Then PL.Interior.Color = 12611584 'colore la plage PL de Bleu foncé If PL.Address <> "$C$1" Then PL.Interior.Color = 15773696 'colore la plage PL de Bleu clair If PL.Address <> "$D$1" Then PL.Interior.Color = 49407 'colore la plage PL d'orange End Sub
Lorsque je rentre une date dans mon userform 1 tel que : 11/05/2015 , celle-ci est correctement integré dans mon tableau , mais losrque je double clic pour modifier, je modifie ma date tel que : 12/05/2015 , je valide, et celle ci se transforme en 05/12/2015 , de meme que si je rentre 13/05/2015, elle se transforme en 05/13/2015 .
J'espert avoir correctement expliqué mon problème, cordialement .
Partager