Problème de date

**Patouillou** · 01/05/2015, 13h15

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

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 :

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

Je vous explique mon problème:

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 .

**joe.levrai** · 01/05/2015, 13h34

Bonjour,

la type de données d'un textbox est toujours un String

quand tu injectes la valeur de ton textbox dans excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("J" & L).Value = TextBox4

VBA lui envoie un string, Excel formate la cellule en date...
le problème c'est que ton Excel est français (format date français) mais que VBA va utiliser le format anglais

il faut convertir le type de données pour la valeur de ton textbox
ici, on transforme le type "String" en type "Date" quand on l'envoie vers Excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("J" & L).Value = CDate(TextBox4)

regarde si c'est ok ... ça doit venir de là mais je peux me tromper, et y'a d'autres solutions si besoin

**Patouillou** · 01/05/2015, 13h41

Tout d'abord, merci de ta reponse rapide,

J'ai tenté de réecrire cette ligne de sorte , mais quand je double-clic sur une ligne a modifié , il me met " Erreur d'exécution 13 Incompatibilité de type "

Cordialement

**joe.levrai** · 01/05/2015, 15h26

je pense que tu n'as pas tout montré, et que ça m'induit en erreur sur le fonctionnement de ta machinerie
d'ailleurs, tu as posté deux fois le même code, et tu parles de deux Userform ... je suis perdu

tu peux nous montrer la procédure évenementielle qui se lance lors du double clic ?

**Patouillou** · 01/05/2015, 15h49

En effet je vien de me rendre compte que j'ai mis le meme userform :

Voici les deux :

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

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

Et voici ma feuille:

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

Problème de date [Toutes versions]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager