Discussion :

[Patouillou]

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:

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

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
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 d’ajout") = 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

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
 
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

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
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