Probleme Date erreur

**tessteur_tt** · 26/07/2012, 09h26

Bonjour à tous,

Voilà à partir de VBA, je dois pouvoir lorsque j'appui sur un bouton dans une de mes feuilles Excel, ouvrir une fenêtre (UseForm) ou je saisi des données. Et notamment la Date. Et il existe un bouton Valider sur cette fenêtre qui lorsque j'appui dessus, insère le courrier dans des feuilles selon la date notamment. Le problème, c'est que j'ai un message d'erreur :

Erreur d'exécution '13'
Incompatibilité de type

Je vous transmet le code afin que vous puissez m'aider.
Merci beaucoup d'avance.

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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
Private Sub Bt_Valider_Click()
 
   Dim no_ligne As Integer
 
    Dim valeur As String
 
 
'Selectionne la bonne feuille en fonction de la Date saisie
 
valeur = Year(CDate(TextBox2.Text))
Sheets(valeur).Activate
 
 
  no_ligne = Range("A65536").End(xlUp).Row + 1
  no_ligne = Range("B65536").End(xlUp).Row + 1
 
 
' Vérification des champs vides obligatoires
 
If ComboBox1 = "" Or ComboBox2 = "" Or ComboBox3 = "" Or ComboBox4 = "" Or TextBox1 = "" Or TextBox3 = "" Then
 
' Message d'erreur si les champs obligatoires ne sont pas remplis
 
MsgBox "Erreur : Veuillez remplir tous les champs obligatoires de la fenêtre (qui ne sont pas en gris)"
 
Else
 
' Test pour la Date
 
If Not IsDate(TextBox2) Then
 
MsgBox "Erreur : Veuillez saisir correctement la Date"
 
Else
 
    ' Test pour le Tableau de bord
 
If Not IsNumeric(TextBox5) And IsEmpty(TextBox5) Then
 
MsgBox "Erreur : Tableau de bord"
 
Else
 
 
    ' Insère dans la feuille dans le cas ou toutes les conditions sont validées
 
        MsgBox "Le Courrier a bien été inséré"
 
        Cells(no_ligne, 1) = ComboBox1.Value
        Cells(no_ligne, 2) = ComboBox2.Value
        Cells(no_ligne, 3) = ComboBox3.Value
        Cells(no_ligne, 4) = ComboBox4.Value
        Cells(no_ligne, 5) = TextBox1.Value
        Cells(no_ligne, 6) = TextBox2.Value
        Cells(no_ligne, 7) = TextBox3.Value
        Cells(no_ligne, 8) = ComboBox5.Value
        Cells(no_ligne, 9) = TextBox4.Value
        Cells(no_ligne, 10) = TextBox5.Value
 
        'Insertion du lien hypertexte
 
        If TextBox6.Value <> "" Then
 
            Cells(no_ligne, 11).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
            TextBox6.Value, _
            TextToDisplay:=TextBox6.Value
 
        End If
 
        ' Les champs sont vidés si tout est bien validé
 
        TextBox1 = ""
        TextBox2 = ""
        TextBox3 = ""
        TextBox4 = ""
        TextBox5 = ""
        TextBox6 = ""
        ComboBox1 = ""
        ComboBox2 = ""
        ComboBox3 = ""
        ComboBox4 = ""
        ComboBox5 = ""
 
 
End If
End If
End If
 
 
End Sub
 
 
Private Sub ComboBox1_Change()
 
End Sub
 
Private Sub ComboBox2_Change()
 
End Sub
 
Private Sub ComboBox3_Change()
 
End Sub
 
Private Sub ComboBox4_Change()
 
End Sub
 
Private Sub Frame1_Click()
 
End Sub
 
Private Sub ComboBox5_Change()
 
End Sub
 
Private Sub CommandButton1_Click()
 
Dim valeur As String
valeur = Year(TextBox2)
Sheets(valeur).Activate
 
Range("K65536").End(xlUp).Offset(1, 0).Select
 
Application.Dialogs(xlDialogInsertHyperlink).Show
 
TextBox6 = ActiveCell.Hyperlinks(1).Address
 
ActiveCell.Delete
 
End Sub
 
 
Private Sub CommandButton2_Click()
' Bouton "Annuler" qui ferme la fenêtre de saisie si on clique dessus
 
Unload Me
 
Exit Sub
 
End Sub
 
Private Sub Label1_Click()
 
End Sub
 
Private Sub Label11_Click()
 
End Sub
 
Private Sub Label13_Click()
 
 
End Sub
 
Private Sub Label2_Click()
 
End Sub
 
Private Sub Label3_Click()
 
End Sub
 
Private Sub Label4_Click()
 
End Sub
 
Private Sub Label5_Click()
 
End Sub
 
Private Sub Label6_Click()
 
End Sub
 
Private Sub Label7_Click()
 
End Sub
 
Private Sub OK_Click()
 
End Sub
 
Private Sub Label8_Click()
 
End Sub
 
Private Sub TextBox1_Change()
 
End Sub
 
Private Sub TextBox2_Change()
 
    Dim valeur As Byte
    TextBox2.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    valeur = Len(TextBox2)
    If valeur = 2 Or valeur = 5 Then TextBox2 = TextBox2 & "/"
 
 
End Sub
 
 
Private Sub TextBox4_Change()
 
End Sub
 
Private Sub TextBox5_Change()
 
 
End Sub
 
Private Sub TextBox6_Change()
 
 
End Sub
 
 
Private Sub UserForm_Activate()
 
 
End Sub
 
Private Sub UserForm_Initialize()
 
'Bon Format de la Date à saisir
 
TextBox2.Value = Format(Date, "dd/mm/yyyy")
 
End Sub
 
Private Sub TextBox3_Change()
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub

**QuestVba** · 26/07/2012, 12h47

Bonjour,

J'ai essayé chez moi et je n'ai qu'une erreur avec la ligne

Code :

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

1
2
valeur = Year(TextBox2)
Sheets(valeur).Activate

En effet, la valeur qui ressort chez moi a un petit espace devant 2012 (" 2012").

Donc, j'ai modifié ainsi

Code :

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

1
2
valeur = Right(Str(Year(TextBox2)), 4)
Sheets(valeur).Activate

et tout fonctionne.

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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
Private Sub Bt_Valider_Click()
 
   Dim no_ligne As Integer
 
    Dim valeur As String
 
 
'Selectionne la bonne feuille en fonction de la Date saisie
 
valeur = Year(CDate(TextBox2.Text))
Sheets(valeur).Activate
 
 
  no_ligne = Range("A65536").End(xlUp).Row + 1
  no_ligne = Range("B65536").End(xlUp).Row + 1
 
 
' Vérification des champs vides obligatoires
 
If ComboBox1 = "" Or ComboBox2 = "" Or ComboBox3 = "" Or ComboBox4 = "" Or TextBox1 = "" Or TextBox3 = "" Then
 
' Message d'erreur si les champs obligatoires ne sont pas remplis
 
MsgBox "Erreur : Veuillez remplir tous les champs obligatoires de la fenêtre (qui ne sont pas en gris)"
 
Else
 
' Test pour la Date
 
If Not IsDate(TextBox2) Then
 
MsgBox "Erreur : Veuillez saisir correctement la Date"
 
Else
 
    ' Test pour le Tableau de bord
 
If Not IsNumeric(TextBox5) And IsEmpty(TextBox5) Then
 
MsgBox "Erreur : Tableau de bord"
 
Else
 
 
    ' Insère dans la feuille dans le cas ou toutes les conditions sont validées
 
        MsgBox "Le Courrier a bien été inséré"
 
        Cells(no_ligne, 1) = ComboBox1.Value
        Cells(no_ligne, 2) = ComboBox2.Value
        Cells(no_ligne, 3) = ComboBox3.Value
        Cells(no_ligne, 4) = ComboBox4.Value
        Cells(no_ligne, 5) = TextBox1.Value
        Cells(no_ligne, 6) = TextBox2.Value
        Cells(no_ligne, 7) = TextBox3.Value
        Cells(no_ligne, 8) = ComboBox5.Value
        Cells(no_ligne, 9) = TextBox4.Value
        Cells(no_ligne, 10) = TextBox5.Value
 
        'Insertion du lien hypertexte
 
        If TextBox6.Value <> "" Then
 
            Cells(no_ligne, 11).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
            TextBox6.Value, _
            TextToDisplay:=TextBox6.Value
 
        End If
 
        ' Les champs sont vidés si tout est bien validé
 
        TextBox1 = ""
        TextBox2 = ""
        TextBox3 = ""
        TextBox4 = ""
        TextBox5 = ""
        TextBox6 = ""
        ComboBox1 = ""
        ComboBox2 = ""
        ComboBox3 = ""
        ComboBox4 = ""
        ComboBox5 = ""
 
 
End If
End If
End If
 
 
End Sub
 
 
Private Sub ComboBox1_Change()
 
End Sub
 
Private Sub ComboBox2_Change()
 
End Sub
 
Private Sub ComboBox3_Change()
 
End Sub
 
Private Sub ComboBox4_Change()
 
End Sub
 
Private Sub Frame1_Click()
 
End Sub
 
Private Sub ComboBox5_Change()
 
End Sub
 
Private Sub CommandButton1_Click()
 
Dim valeur As String
valeur = Right(Str(Year(TextBox2)), 4)

Sheets(valeur).Activate
 
Range("K65536").End(xlUp).Offset(1, 0).Select
 
Application.Dialogs(xlDialogInsertHyperlink).Show
 
TextBox6 = ActiveCell.Hyperlinks(1).Address
 
ActiveCell.Delete
 
End Sub
 
 
Private Sub CommandButton2_Click()
' Bouton "Annuler" qui ferme la fenêtre de saisie si on clique dessus
 
Unload Me
 
Exit Sub
 
End Sub
 
Private Sub Label1_Click()
 
End Sub
 
Private Sub Label11_Click()
 
End Sub
 
Private Sub Label13_Click()
 
 
End Sub
 
Private Sub Label2_Click()
 
End Sub
 
Private Sub Label3_Click()
 
End Sub
 
Private Sub Label4_Click()
 
End Sub
 
Private Sub Label5_Click()
 
End Sub
 
Private Sub Label6_Click()
 
End Sub
 
Private Sub Label7_Click()
 
End Sub
 
Private Sub OK_Click()
 
End Sub
 
Private Sub Label8_Click()
 
End Sub
 
Private Sub TextBox1_Change()
 
End Sub
 
Private Sub TextBox2_Change()
 
    Dim valeur As Byte
    TextBox2.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    valeur = Len(TextBox2)
    If valeur = 2 Or valeur = 5 Then TextBox2 = TextBox2 & "/"
 
 
End Sub
 
 
Private Sub TextBox4_Change()
 
End Sub
 
Private Sub TextBox5_Change()
 
 
End Sub
 
Private Sub TextBox6_Change()
 
 
End Sub
 
 
Private Sub UserForm_Activate()
 
 
End Sub
 
Private Sub UserForm_Initialize()
 
'Bon Format de la Date à saisir
 
TextBox2.Value = Format(Date, "dd/mm/yyyy")
 
End Sub
 
Private Sub TextBox3_Change()
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub

Probleme Date erreur

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager