Mon problème est expliqué dans les photos :
Voici mon tableau avec les boutons "Nouveau suivi" et " Rechercher":
Ici, je vais créer un nouveau suivi , seule la date nous interesse.
Toutes les valeurs ont été entrées correctement dans les cellules.
Je double clic pour modifier ma ligne, toutes les valeurs rentrée précedement sont normalement inscritent dont la date (05/06/2015)
Ici, on peus voir la date qui est passé de 05/06/2015 à 06/05/2015...
Le truc, c'est que la date, change à chaque fois que l'on appuie sur le bouton modifier , c'est à dire qu'elle passe de 05/06/2015 à 06/05/2015 puis cela recommence, on réapuis sur modifier et la date repasse en 05/06/2015 ... meme si on à rien changer dans l'userform.... Je pense que le problème se situe dans les tag, dans l'userform3 , mais je ne sais pas le résoudre :'(
Merci à ceux que résouderons mon problème :p
Cordialement
Les codes sont écrits en dessous.
Feuille1:
Userform1 ( ajouter une ligne) :
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 Private Sub CommandButton1_Click() ActiveCell.Select 'enlève le focus au bouton UserForm1.Show 'ouvre l'UserForm1 End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 Then Exit Sub 'si le changement à lieu ailleurs que dans la colonne 3 (=C), sort de la procédure 'adapte le 20 au nombre de colonnes que tu désires colorer If Target.Value = "TOURS" Then Target.Resize(1, 16).Interior.Color = 5296274 If Target.Value = "POITIERS" Then Target.Resize(1, 16).Interior.Color = 5296274 If Target.Value = "LE MANS" Then Target.Resize(1, 16).Interior.Color = 5296274 If Target.Value = "ANGERS" Then Target.Resize(1, 16).Interior.Color = 5296274 If Target.Value = "RENNES" Then Target.Resize(1, 16).Interior.Color = 12611584 If Target.Value = "NANTES" Then Target.Resize(1, 16).Interior.Color = 12611584 If Target.Value = "BREST" Then Target.Resize(1, 16).Interior.Color = 12611584 If Target.Value = "CAEN" Then Target.Resize(1, 16).Interior.Color = 15773696 If Target.Value = "BORDEAUX" Then Target.Resize(1, 16).Interior.Color = 49407 If Target.Value = "CHARTRES" Then Target.Resize(1, 16).Interior.Color = 49407 End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au boucle-clic dans l'onglet 'si le boucle clic a lieu dans la ligne 1 ou dans une colonne supérieure à 17 (=R), sort de la procédure If Target.Row < 3 And Target.Column > 17 Then Exit Sub Cancel = True 'annule le mode [Édition] lié au double-clic UserForm3.Show 'ouvre l'UserForm3 End Sub
UserForm2 (rechercher) :
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
158 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("", "SALMSON", "GRUNDFOS", "PNEUMATEX", "WILO", "XYLEM", "AUTRE") 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
UserForm3 ( Modfier en double clic ) :
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 Private O As Worksheet 'déclare la variable O (Onglet) Private TC As Variant 'déclare la variable TC (Tableau de Cellules) Private NL As Integer 'déclare la variable NL (Nombre de Lignes) Private NC As Integer 'déclare la variable NC (Nombre de Colonnes) Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm 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 ligne NL NC = UBound(TC, 2) 'définit le nombre de colonnes NC Me.ListBox1.ColumnCount = NC 'définit le nombre de colonne de la ListBox1 End Sub Private Sub TextBox1_Change() 'au changement dans la Textbox1 Dim I As Integer 'déclare la variable I (Incrément) Dim J As Integer 'déclare la variable J (incrément) Dim K As Integer 'déclare la variable L (incrément) Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées) Dim L As Integer 'déclare la variable L (incrément) If Me.TextBox1.Value = "" Then 'condition : si la Textbox1 est effacée Me.ListBox1.Clear 'vide la ListBox1 Me.Label1.Caption = "" 'efface la Label1 Exit Sub 'sort de la procédure End If 'fin de la condition Me.ListBox1.Clear 'vide la ListBox1 K = 1 'initialise la variable K For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde) For J = 1 To NC 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC 'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC If UCase(TC(I, J)) Like "*" & UCase(Me.TextBox1.Value) & "*" Then 'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes) ReDim Preserve TOT(1 To NC, 1 To K) For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC TOT(L, K) = TC(I, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC Next L 'prochaine colonne de la boucle 3 K = K + 1 'incrémete K (nouvelle colonne pour TOT) Exit For 'sort de la boucle 2 End If 'fin de la condition Next J 'prochaine colonne de la boucle 2 Next I 'prochaine ligne de la boucle 1 On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante) 'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...) If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2) 'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne) Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide 'si une erreur a été générée, message, sort de la procédure If Err <> 0 Then Me.Label1.Caption = "Aucune occurrence trouvée !": Exit Sub Me.Label1.Caption = K - 1 & IIf(K - 1 = 1, " occurrence trouvé !", " occurrences trouvées !") End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'au double-clic dans la ListBox1 Dim I As Integer 'déclare la variable I (Incrément) Dim J As Integer 'déclare la variable J (Incrément) For I = 0 To Me.ListBox1.ListCount - 1 'Boucle 1 : sur toutes les lignes de la ListBox1 If Me.ListBox1.Selected(I) = True Then 'condition 1 : si la ligne est sélectionnée For J = 2 To NL 'boucle 2 : sur toutes les lignes du tabelau TC If TC(J, 2) = Me.ListBox1.Column(1, I) Then 'condition 2 : si les numéros de HYD sont égaux O.Rows(J).Select 'sélecionne la ligne J de l'onglet O Unload Me 'vide et ferme l'Usersorm Exit Sub 'sort de la procédure End If 'fin de la condition 2 Next J 'prochaine ligne de la boucle 2 End If 'fin de la condition 1 Next I 'prochaine ligne de la boucle 1 UserForm3.Show End Sub
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 O As Worksheet 'déclare la variable O (Onglet) Private LI As Integer 'déclare la variable LI (LIgne) Private CTRL As Control 'déclare la variable CTRL (ConTRôLe) Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm Set O = Sheets("RECAPITULATIF") 'définit l'ontglet O If Nouveau = True Then 'condition : si la variable nouveau est [Vrai] Me.Caption = "SAISIE DES INTERVENTIONS" 'définit le titre de la boîter de dialogue LI = O.Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la ligne LI TextBox15.Value = WorksheetFunction.Max(O.Columns(2)) + 1 'incrémente le numnéro de l'intervention Else 'sinon Me.Caption = "MODIFIER" 'définit le titre de la boîter de dialogue LI = ActiveCell.Row 'définit la ligne LI TextBox15.Value = O.Cells(LI, 2).Value 'récupèr ele numéro d'intervention TextBox5.Value = O.Cells(LI, 4).Value TextBox1.Value = O.Cells(LI, 5).Value TextBox7.Value = O.Cells(LI, 7).Value TextBox2.Value = O.Cells(LI, 8).Value TextBox11.Value = O.Cells(LI, 13).Value TextBox4.Value = O.Cells(LI, 10).Value TextBox3.Value = O.Cells(LI, 9).Value TextBox13.Value = O.Cells(LI, 16).Value TextBox12.Value = O.Cells(LI, 15).Value TextBox14.Value = O.Cells(LI, 17).Value TextBox16.Value = O.Cells(LI, 18).Value ComboBox2.Value = O.Cells(LI, 3).Value ComboBox6.Value = O.Cells(LI, 6).Value ComboBox3.Value = O.Cells(LI, 14).Value ComboBox5.Value = O.Cells(LI, 12).Value ComboBox4.Value = O.Cells(LI, 11).Value ComboBox3.Value = O.Cells(LI, 14).Value End If Nouveau = False ComboBox2.List() = Array("", "CAEN", "ANGERS", "LE MANS", "TOURS", "POITIERS", "NANTES", "RENNES", "BREST", "BORDEAUX") 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("", "SALMSON", "GRUNDFOS", "PNEUMATEX", "WILO", "XYLEM", "AUTRE") End Sub Private Sub CommandButton1_Click() 'bouton "VALIDATION" For Each CTRL In Me.Controls 'boucle sur tous les contrôles de l'userForm 'si la propriété [Tag] du contrôle n'est pas vide, renvoie la valeur du contrôle CTRL 'dans la cellule ligne LI colonne [Tag] (converti en entier) du contrôle, de l'onglet O If CTRL.Tag <> "" Then O.Cells(LI, CInt(CTRL.Tag)).Value = CTRL.Value Next CTRL 'prochain contrôle de la boucle Unload Me 'vide et ferme l'UserForm If Not IsDate(TextBox4) Then MsgBox "Date non-présente ou incorrecte" TextBox4 = "" Exit Sub '...la suite de la procédure End If End Sub Private Sub CommandButton3_Click() 'bouton "QUITTER" Unload Me 'vide et ferme l'UserForm End Sub Private Sub TextBox5_Change() 'MOdif Instalateur TextBox5.Tag = 4 End Sub Private Sub ComboBox2_Change() ' modif Agence ComboBox2.Tag = 3 End Sub Private Sub ComboBox5_Change() 'modif facture ComboBox5.Tag = 12 End Sub Private Sub TextBox12_Change() 'MOdif Adresse TextBox12.Tag = 15 End Sub Private Sub TextBox13_Change() 'MOdif Code postale TextBox13.Tag = 16 End Sub Private Sub TextBox14_Change() 'MOdif Ville TextBox14.Tag = 17 End Sub Private Sub TextBox3_Change() 'MOdif Montant TextBox3.Tag = 9 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 & "/" TextBox4.Tag = 10 End Sub Private Sub TextBox11_Change() 'MOdif Contact TextBox11.Tag = 13 End Sub Private Sub TextBox7_Change() 'MOdif Produit TextBox7.Tag = 7 End Sub Private Sub TextBox1_Change() 'MOdif Chantier TextBox1.Tag = 5 End Sub Private Sub ComboBox6_Change() 'modif Marque ComboBox6.Tag = 6 End Sub Private Sub ComboBox3_Change() 'modif Type ComboBox3.Tag = 14 End Sub Private Sub ComboBox4_Change() 'modif Terminé ComboBox4.Tag = 11 End Sub Private Sub TextBox2_Change() 'MOdif N°arc TextBox2.Tag = 8 End Sub Private Sub TextBox15_Change() 'MOdif N°arc TextBox15.Tag = 2 End Sub Private Sub TextBox16_Change() 'MOdif Commentaire TextBox16.Tag = 18 End Sub
Partager