Créer un commandbutton qui enregistre et modifie

Version imprimable

12/07/2018, 23h41
Mr l'Ashanti

Créer un commandbutton qui enregistre et modifie

Bjr. Suis un débutant en VBA. Je souhaiterais aider mes collègues enseignants pour leur faciliter l'enregistrement des élèves dans leurs établissements.
Voici mon problème : j'ai créé un commandbutton qui a deux fonctions enregistrer et modifier. Mais la deuxième fonction ''modifier'' je ne sais comment faire . J'ai mis plusieurs codes mais rien au niveau des cellules. En fait après recherche dans la combo box, les références de l'élève s'affiche dans les différentes textbox et là je porte des modifications mais hélas cela ne marche pas.
Si quelqu'un pouvait m'aider ça sera un plaisir énorme pour moi. Merci.
14/07/2018, 13h38
Thautheme

Bonjour Niamké, bonjour le forum,

Donne-nous au moins ton code pour que nous puissions t'aider !...
14/07/2018, 21h26
Mr l'Ashanti

Ok. Mais comment faire pour mettre mon fichier ici.
14/07/2018, 22h43
Thautheme

Re,

Le code pour le moment... Sinon juste en dessous il y a un bouton Gérer les pièces jointes...
20/07/2018, 09h10
Mr l'Ashanti

1 pièce(s) jointe(s)

bonjour thautheme.voici mon fichier. excuse moi du retard car j avais un probleme avec ma connection
Pièce jointe 397943

Re,

Que de complications !...

Les modifs :
• Au début :

Code:

1
2
Option Explicit
Private LI As Integer

• au changement dans la ComboBox de recherche par nom

Code:

1
2
3
4
5
Private Sub Cbo_search_Change()
'...
cherche = Cbo_search.Value
z = Sheets("source").Cells.Find(what:=cherche, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlNext).Row
LI = z

• Au changement dans la ComboBox de recherche par matricule

Code:

1
2
3
4
5
Private Sub Cbo_mat_Change()
'...
cherche = Cbo_mat.Value
z = Sheets("source").Cells.Find(what:=cherche, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlNext).Row 'afficher les données dans les
LI = z

• au bouton Enregistrer/Modifier

Code:

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
Private Sub Bt1_Click()
 
Dim ligne As Long
Dim derniereligne As String
 
'With Sheets("source")
'.Unprotect Password:=5470
 
If LI <> 0 Then
    If msgbox("Voulez vous modifier ces données ?", vbYesNo + vbQuestion, "CONFIMARTION") = vbYes Then
        derniereligne = LI 'commmencer a compter de la derniere ligne vers le bas pour aller
        Sheets("source").Range("c" & derniereligne) = Me.T_nom
        Sheets("source").Range("d" & derniereligne) = Me.Cbo_sexe
        Sheets("source").Range("e" & derniereligne) = Me.T_date
        Sheets("source").Range("f" & derniereligne) = Me.T_extrait
        Sheets("source").Range("g" & derniereligne) = Me.Cbo_classe
        Sheets("source").Range("h" & derniereligne) = Me.Cbo_statut
        GoTo suite
    End If
End If
 
'enregistrer les données des textbox et combos box dans les cellules de la feuille active
If T_nom <> "" Or T_date <> "" Or T_extrait <> "" Or Cbo_sexe <> "" Or Cbo_classe <> "" Or Cbo_statut <> "" Then
If msgbox("Voulez vous ajouter ces données ?", vbYesNo + vbQuestion, "CONFIMARTION") = vbYes Then
 
 
        Sheets("source").ListObjects(1).ListRows.Add
 
        derniereligne = Sheets("source").Range("C1500").End(xlUp).Row 'commmencer a compter de la derniere ligne vers le bas pour aller
        'à la derniere ligne non vide
 
        Sheets("source").Range("c" & derniereligne) = Me.T_nom
        Sheets("source").Range("d" & derniereligne) = Me.Cbo_sexe
        Sheets("source").Range("e" & derniereligne) = Me.T_date
        Sheets("source").Range("f" & derniereligne) = Me.T_extrait
        Sheets("source").Range("g" & derniereligne) = Me.Cbo_classe
        Sheets("source").Range("h" & derniereligne) = Me.Cbo_statut
 
 
  End If
End If
suite:
'effacer tous les champs apres enregistrement ou modification des données

20/07/2018, 14h07
Mr l'Ashanti

Merci un frère d'avoir pris le temps de m'aider. 🍕🍕🍕Je vérifie et je te fais un feedback.
21/07/2018, 12h59
Mr l'Ashanti

Modification impossible avec le nouveau code reçu

Bjr Thautheme. Merci pour le code. J ai reçu à le copier mais quand je porte la modification sur les informations concernant l'élève rien ne se passe au niveau de ma base de données. Merci de m'aider.😉😉😉

Bonjour Niamké, bonjour le forum,

Il faut supprimer les propriétés RowSource des comboboxes de recherche (Cbo_search et Cbo_mat) ! Je les ai alimentées à l'Initialisation de l'UserForm. Ça à l'air de fonctionner...
Le code complet de l'Userform. Écrase l'ancien code :

Code:

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
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
Option Explicit
Private O As Worksheet
Private DL As Long
Private LI As Integer
 
Private Sub UserForm_Initialize()
Set O = Worksheets("SOURCE")
DL = IIf(O.Range("C8").Value = "", 8, O.Range("C7").End(xlDown).Row)
Me.Cbo_search.List = O.Range("C8:C" & DL).Value
Me.Cbo_mat.List = O.Range("B8:B" & DL).Value
End Sub
 
'afficher l'userform en plein écran
Private Sub UserForm_activate()
Dim derniereligne As Integer
Dim a As Integer
 
With Me
    .Zoom = 100 * (Application.Width / Me.Width)
    .StartUpPosition = 3
    .Width = Application.Width
    .Height = Application.Height
    .Left = -6
    .Top = -20
End With
If T_nom <> "" Or T_date <> "" Or T_extrait <> "" Or Cbo_sexe <> "" Or Cbo_classe <> "" Or Cbo_statut <> "" Then
    O.ListObjects(1).ListRows.Add
    derniereligne = O.Range("C1500").End(xlUp).Row 'commmencer a compter de la derniere ligne vers le bas pour aller
    O.Range("c" & derniereligne) = Me.T_nom
    O.Range("d" & derniereligne) = Me.Cbo_sexe
    O.Range("e" & derniereligne) = Me.T_date
    O.Range("f" & derniereligne) = Me.T_extrait
    O.Range("g" & derniereligne) = Me.Cbo_classe
    O.Range("h" & derniereligne) = Me.Cbo_statut
End If
End Sub
 
Private Sub T_nom_change() '(1)
 
'procédure permettant de dévérouiller les textbox
If T_nom <> "" Then
    T_date.Enabled = True
    T_extrait.Enabled = True
    Bt2.Enabled = True
    Cbo_search.Enabled = False
    Cbo_sexe.Enabled = True
    Cbo_mat.Enabled = False
Else
    T_date.Enabled = False
    T_extrait.Enabled = False
    Bt2.Enabled = False
    Cbo_search.Enabled = True
    Cbo_sexe.Enabled = False
    Cbo_mat.Enabled = True
End If
T_nom.Text = UCase(T_nom.Text) ' majuscule automatique
If T_nom <> "" Then 'modification du nom Bt1
    Bt1.Caption = " ENREGISTRER"
    Label17.Caption = "ENREGISTREMENT EN COURS..."
    Label17.ForeColor = vbRed
    Else
    Label17.Caption = "PARTIE ENREGISTREMENT"
    Label17.ForeColor = vbBlack
End If
If IsNumeric(T_nom.Value) Then 'si valeur numeric then
    Label7.Caption = "VALEUR INTERDITE" ' label change de nom
    Label7.ForeColor = vbRed 'et de couleur
    MsgBox "ENTRER DES CARACTERES.MERCI", vbCritical, "MESSAGE D'ERREUR"
    Me.T_nom = "" ' vide le champ apres le message
Else
    Label7.Caption = "NOM & PRENOMS "
    Label7.ForeColor = vbBlue
End If
If Cbo_search.Enabled = False Then 'si la case de la recherche est non vide alors les noms des cases changent
    Label18.Caption = "INACTIF"
    Label14.Caption = "INACTIF"
    Label12.Caption = "INACTIF"
    Label15.Caption = "INACTIF"
    Label13.Caption = "INACTIF"
    Label16.Caption = "INACTIF"
    Label20.Caption = "INACTIF"
    Label21.Caption = "INACTIF"
    Label18.Enabled = False
    Label14.Enabled = False
    Label12.Enabled = False
    Label15.Enabled = False
    Label13.Enabled = False
    Label16.Enabled = False
    Label20.Enabled = False
    Label21.Enabled = False
Else
    Cbo_search.Enabled = True
    Label18.Caption = "NOM & PRENOMS"
    Label14.Caption = "SEXE"
    Label12.Caption = "DATE DE NAISSANCE"
    Label15.Caption = "CLASSE"
    Label13.Caption = "NUMERO D'EXTRAIT"
    Label16.Caption = "STATUT"
    Label20.Caption = "RECHERCHE NOM"
    Label21.Caption = "RECHERCHE NUMERO"
    Label18.Enabled = True
    Label14.Enabled = True
    Label12.Enabled = True
    Label15.Enabled = True
    Label13.Enabled = True
    Label16.Enabled = True
    Label20.Enabled = True
    Label21.Enabled = True
End If
If T_nom = "" Then Label7.ForeColor = vbBlack 'changer de couleur si champ nom est vide
End Sub
 
Private Sub T_date_change() '(2)
T_date.Text = LCase(T_date.Text) 'majuscule obligatoire
'changer de couleur pour le label5
If T_date <> "" Then
    Label5.Caption = "DATE DE NAISSANCE "
    Label5.ForeColor = vbBlue
Else
    Label5.ForeColor = vbBlack
End If
End Sub
 
'majuscule automatique
Private Sub T_extrait_Change() '(3)
T_extrait.Text = LCase(T_extrait.Text)
If T_extrait <> "" Then
    Label4.Caption = "NUMERO D'EXTRAIT "
    Label4.ForeColor = vbBlue
Else
    Label4.ForeColor = vbBlack
End If
End Sub
 
'procédure permettant de dévérouiller les combos box
Private Sub Cbo_sexe_Change() '(4)
If Cbo_sexe <> "" Then
    Cbo_classe.Enabled = True
    Cbo_statut.Enabled = True
Else
    Cbo_classe.Enabled = False
    Cbo_statut.Enabled = False
End If
If Cbo_sexe <> "" Then
    Label1.Caption = "SEXE "
    Label1.ForeColor = vbBlue
Else
    Label1.ForeColor = vbBlack
End If
End Sub
 
Private Sub Cbo_classe_Change() '(5)
If Cbo_classe <> "" Then
    Label2.Caption = "CLASSE "
    Label2.ForeColor = vbBlue 'change de couleur
    Else
    Label2.ForeColor = vbBlack 'couleur initiale
End If
End Sub
 
'procédure permettant de dévérouiller le bouton supprimer
Private Sub Cbo_statut_Change() '(6)
If Cbo_statut <> "" Then
    Bt2.Enabled = True
    Bt1.Enabled = True
Else
    Bt2.Enabled = False
    Bt1.Enabled = False
End If
If Cbo_statut <> "" Then
    Label3.Caption = "STATUT "
    Label3.ForeColor = vbBlue
Else
    Label3.ForeColor = vbBlack
End If
End Sub
 
'procédure permettant d'ajouter les nouvelles données
Private Sub Bt1_Click()
Dim ligne As Long
Dim derniereligne As Long
 
O.Unprotect Password:=5470
If LI <> 0 Then
    derniereligne = LI
    If MsgBox("Voulez vous modifier ces données ?", vbYesNo + vbQuestion, "CONFIMARTION") = vbYes Then
        derniereligne = LI 'commmencer a compter de la derniere ligne vers le bas pour aller
        O.Range("c" & derniereligne) = Me.T_nom1
        O.Range("d" & derniereligne) = Me.Cbo_sexe1
        O.Range("e" & derniereligne) = Me.T_date1
        O.Range("f" & derniereligne) = Me.T_extrait1
        O.Range("g" & derniereligne) = Me.Cbo_classe1
        O.Range("h" & derniereligne) = Me.Cbo_statut1
        GoTo suite
    End If
End If
'enregistrer les données des textbox et combos box dans les cellules de la feuille active
If T_nom <> "" Or T_date <> "" Or T_extrait <> "" Or Cbo_sexe <> "" Or Cbo_classe <> "" Or Cbo_statut <> "" Then
    If MsgBox("Voulez vous ajouter ces données ?", vbYesNo + vbQuestion, "CONFIMARTION") = vbYes Then
        O.ListObjects(1).ListRows.Add
        derniereligne = O.Range("C1500").End(xlUp).Row 'commmencer a compter de la derniere ligne vers le bas pour aller
        'à la derniere ligne non vide
        O.Range("c" & derniereligne) = Me.T_nom
        O.Range("d" & derniereligne) = Me.Cbo_sexe
        O.Range("e" & derniereligne) = Me.T_date
        O.Range("f" & derniereligne) = Me.T_extrait
        O.Range("g" & derniereligne) = Me.Cbo_classe
        O.Range("h" & derniereligne) = Me.Cbo_statut
  End If
End If
suite:
O.Protect Password:=5470
Unload Me
Usformulaire.Show
End Sub
 
'procédure permettant de fermer mon formulaire
Private Sub Bt3_Click()
If MsgBox("VOULEZ VOUS QUITTER?", vbYesNo + vbQuestion + vbDefaultButton2, "MESSAGE DE CONFIRMATION") <> vbYes Then Exit Sub
Unload Me
End Sub
 
 Private Sub Bt4_Click()
'voir la source de donnée
    O.Activate
    O.Range("C8").Select
    Unload Me
End Sub
 
Private Sub Cbo_mat_Change()
Cbo_mat.Text = UCase(Cbo_mat.Text) 'forcer la majuscule des cases
 
'procédure permettant de verouiller et dévérouiller les champs
If Cbo_mat <> "" Then
    Cbo_sexe1.Enabled = True
    Cbo_classe1.Enabled = True
    T_date1.Enabled = True
    T_extrait1.Enabled = True
    Cbo_statut1.Enabled = True
    Bt1.Enabled = True
    T_nom1.Enabled = True
    Cbo_sexe.Enabled = False
    Bt2.Enabled = True
Else
    Cbo_sexe1.Enabled = False
    Cbo_classe1.Enabled = False
    T_date1.Enabled = False
    T_extrait1.Enabled = False
    Cbo_statut1.Enabled = False
    Bt1.Enabled = False
    T_nom1.Enabled = False
    Cbo_sexe.Enabled = True
    Bt2.Enabled = False
End If
'si le champ nom est non vide alors le bouton Bt1 devient "modifier"
If Cbo_mat <> "" Then
    Bt1.Caption = " MODIFIER"
    Bt1.BackColor = &H80FF&
    Bt1.ControlTipText = "MODIFIER LES INFORMATIONS CONCERNANT L'ELEVE"
Else 'sinon
    Bt1.Caption = "ENREGISTRER"
    Bt1.BackColor = &H8000000D
    Bt1.ControlTipText = "ENREGISTRER DE NOUVELLES DONNEES"
End If
Dim z As Integer
Dim cherche As String
cherche = Cbo_mat.Value
z = O.Cells.Find(what:=cherche, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlNext).Row 'afficher les données dans les
LI = z
'texbox
T_nom1 = Range("b" & z).Offset(0, 1).Value
Cbo_sexe1 = Range("b" & z).Offset(0, 2).Value
T_date1 = Range("b" & z).Offset(0, 3).Value
T_extrait1 = Range("b" & z).Offset(0, 4).Value
Cbo_classe1 = Range("b" & z).Offset(0, 5).Value
Cbo_statut1 = Range("b" & z).Offset(0, 6).Value
End Sub
 
Private Sub Cbo_search_Change()
Dim z As Integer
Dim cherche As String
 
'afficher les references liées à la recherche dans les textbox
cherche = Cbo_search.Value
z = O.Cells.Find(what:=cherche, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlNext).Row
LI = z
Cbo_mat = O.Range("a" & z).Offset(0, 1).Value
T_nom1 = O.Range("a" & z).Offset(0, 2).Value
Cbo_sexe1 = O.Range("a" & z).Offset(0, 3).Value
T_date1 = O.Range("a" & z).Offset(0, 4).Value
T_extrait1 = O.Range("a" & z).Offset(0, 5).Value
Cbo_classe1 = O.Range("a" & z).Offset(0, 6).Value
Cbo_statut1 = O.Range("a" & z).Offset(0, 7).Value
Cbo_search.Text = UCase(Cbo_search.Text) 'forcer la majuscule des cases
'procédure permettant de verouiller et dévérouiller les champs
If Cbo_search <> "" Then
    Cbo_sexe1.Enabled = True
    Cbo_classe1.Enabled = True
    T_date1.Enabled = True
    T_extrait1.Enabled = True
    Cbo_statut1.Enabled = True
    Bt1.Enabled = True
    T_nom1.Enabled = True
    Cbo_sexe.Enabled = False
    Bt2.Enabled = True
    'Cbo_search.Locked = True
Else
    Cbo_sexe1.Enabled = False
    Cbo_classe1.Enabled = False
    T_date1.Enabled = False
    T_extrait1.Enabled = False
    Cbo_statut1.Enabled = False
    Bt1.Enabled = False
    T_nom1.Enabled = False
    Cbo_sexe.Enabled = True
    Bt2.Enabled = False
    'Cbo_search.Locked = False
End If
'si le champ nom est non vide alors le bouton Bt1 devient "modifier"
If Cbo_search <> "" Then
    Bt1.Caption = " MODIFIER"
    Bt1.BackColor = &H80FF&
    Bt1.ControlTipText = "Modifier les informations dans la base de donnée"
Else 'sinon
    Bt1.Caption = "ENREGISTRER"
    Bt1.BackColor = &H8000000D
    Bt1.ControlTipText = "ENREGISTRER DE NOUVELLES DONNEES"
End If
If Cbo_search <> "" Then
    Label19.Caption = "RESULTAT DE LA RECHERCHE" ' le label change de nom
    Label9.Caption = "MODIFICATION EN COURS..."
    Label20.Caption = "RECHERCHE NOM"
    Label20.ForeColor = vbBlue 'le label change de couleur
    Label9.ForeColor = vbBlue
    Label19.ForeColor = vbBlue
    Label21.ForeColor = vbBlue
Else 'sinon
    Label19.Caption = "PARTIE RECHERCHE"
    Label9.Caption = "PARTIE MODIFICATION DES INFORMATIONS"
    Label19.ForeColor = vbBlack
    Label9.ForeColor = vbBlack
    Label20.ForeColor = vbBlack
    Label21.ForeColor = vbBlack
End If
If T_nom.Enabled = False Then ' si case actif alors
    Label7.Caption = "INACTIF"
    Label1.Caption = "INACTIF"
    Label2.Caption = "INACTIF"
    Label3.Caption = "INACTIF"
    Label5.Caption = "INACTIF"
    Label4.Caption = "INACTIF"
    Label7.Enabled = False 'activation des labels fausse
    Label1.Enabled = False
    Label2.Enabled = False
    Label3.Enabled = False
    Label5.Enabled = False
    Label4.Enabled = False
Else
    T_nom.Enabled = True
    Label7.Caption = "NOM & PRENOMS"
    Label1.Caption = "SEXE"
    Label2.Caption = "CLASSE"
    Label3.Caption = "STATUT"
    Label5.Caption = "DATE DE NAISSANCE"
    Label4.Caption = "NUMERO D'EXTRAIT"
    Label7.Enabled = True
    Label1.Enabled = True
    Label2.Enabled = True
    Label3.Enabled = True
    Label5.Enabled = True
    Label4.Enabled = True
End If
End Sub
 
Private Sub Cbo_classe1_Change()
Cbo_classe1.Text = UCase(Cbo_classe1.Text) 'forcer la majuscule
If Cbo_classe1 <> "" Then
    Label15.Caption = "CLASSE "
    Label15.ForeColor = vbBlue 'changer de couleur si le champ n'est pas vide
Else
    Label15.ForeColor = vbBlack
End If
End Sub
 
Private Sub T_date1_Change()
If T_date1 <> "" Then
    Label12.Caption = "DATE DE NAISSANCE "
    Label12.ForeColor = vbBlue
Else
    Label12.ForeColor = vbBlack
End If
End Sub
 
Private Sub T_extrait1_Change()
T_extrait1.Text = LCase(T_extrait1.Text) 'minuscule obligatoire
If T_extrait1 <> "" Then 'changer de couleur pour le label13
    Label13.Caption = "NUMERO D'EXTRAIT "
    Label13.ForeColor = vbBlue
Else
    Label13.ForeColor = vbBlack
End If
End Sub
 
Private Sub T_nom1_Change()
T_nom1.Text = UCase(T_nom1.Text)
If T_nom1 <> "" Then
    Label18.Caption = "NOM & PRENOMS "
    Label18.ForeColor = vbBlue
Else
    Label18.ForeColor = vbBlack
End If
If T_nom1 <> "" Then
    T_nom.Enabled = False
Else
    T_nom.Enabled = True
End If
End Sub
 
Private Sub Cbo_sexe1_Change()
Cbo_sexe1.Text = UCase(Cbo_sexe1.Text)
If Cbo_sexe1 <> "" Then
    Label14.Caption = "SEXE "
    Label14.ForeColor = vbBlue
Else
    Label14.ForeColor = vbBlack
End If
End Sub
 
Private Sub cbo_statut1_Change()
Cbo_statut1.Text = UCase(Cbo_statut1.Text)
If Cbo_statut1 <> "" Then
    Label16.Caption = "STATUT "
    Label16.ForeColor = vbBlue
Else
    Label16.ForeColor = vbBlack
End If
End Sub

23/07/2018, 12h43
Mr l'Ashanti

Merci pour ton aide et ta disponibilité. Voici un cadeau de ma part🐎🐎🐎🐎

Bjr Thautheme. Quand je supprime les différents Row sources de mes combobox il y a un message d'erreur qui s'affiche.
Erreur 381et après mon pc s'est planqué. Donc j ai du redémarrer. Voici le message d'erreur : impossible de définir la propriété list. Index de table de propriétés non valide.

Même quand je remets les différents Row sources. Même message apparaît...

J ai du obliger l'userform à accepter l'erreur en mettant: on erreur resume next...
Maintenant si il y'a une possibilité de rectifier le premier tire je suis à l'écoute. Merci énormément...
Les combobox n'affichent pas leurs différentes listes déroulantes . Quel est le problème ? Surtout que j'ai supprimé le paramètre Row sources.

Voici les remarques : la modification des noms s'effectue sans problème. Concernant les autres références date de naissance, Extra de naissance, statut, classe et sexe la modification se fait par intermittence. Souvent ça marche et d'autres parts non Et pourtant tous les codes sont correctes !!! Je me demande ce qui ne va pas.??😤😤😤
Merci de tout cœur ami...🐱🐱

Bonjour niamké
peux tu me dire a quoi te sert ceci dans le activate

Code:

1
2
3
4
5
6
7
8
9
10
11
If T_nom <> "" Or T_date <> "" Or T_extrait <> "" Or Cbo_sexe <> "" Or Cbo_classe <> "" Or Cbo_statut <> "" Then
        Sheets("source").ListObjects(1).ListRows.Add
        derniereligne = Sheets("source").Range("C1500").End(xlUp).Row    'commmencer a compter de la derniere ligne vers le bas pour aller
        'a la derniere ligne non vide
        Sheets("source").Range("c" & derniereligne) = Me.T_nom
        Sheets("source").Range("d" & derniereligne) = Me.Cbo_sexe
        Sheets("source").Range("e" & derniereligne) = Me.T_date
        Sheets("source").Range("f" & derniereligne) = Me.T_extrait
        Sheets("source").Range("g" & derniereligne) = Me.Cbo_classe
        Sheets("source").Range("h" & derniereligne) = Me.Cbo_statut
    End If

Absolument a rien !! car l'evenement se declenche a l'activation et les textbox sont vides

ensuite
pour dimentionner le userform par raport a l'application pour le mettre en plein ecran ,il faudrait s'assurer que l'application est elle meme maximisée sinon c'est pas bon
ou se servir des api widows qui font un travail bien plus propre
conclusion pour moi la seul chose d'utile dans ton activate se resume a ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
[Option Explicit
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'trouver le handle
Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'on redessine la barre sinon elle se retrouve en bas de l'userform
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'afficher le userform 1 mode fenetre ,2 mode reduit , 3 plein ecran
Private Declare Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
'afficher l'userform en plein écran
Private Sub UserForm_activate()
    Dim handle&
    handle = fwa(vbNullString, Me.Caption)
    SetWindowLongA handle, -16, &H94080080: SetWindowLongA handle, -20, &H0:    ' sans caption
    DrawMenuBar handle
    showw handle, 3
end sub

voila pas de caption est vraiment plein ecran barre des tache invisible

je regarde le reste mais je crois qu'il y a beaucoup de choses inutiles
si tu est en office 64 dis le moi je corrigerais les apis

23/07/2018, 13h03
Mr l'Ashanti

Merci pour ton aide. Effectivement je voudrais y voir clair mais étant que j'ai aucune base dans la programmation voir les API Windows donc j'ai du bidouiller. Quand je regarde dans le gestionnaire des tâches mon office affiche 32bit or je l'ai téléchargé en 64 bit. Donc je ne sais pas trop... Mais je crois que c'est 32 vu le gestionnaire me l'affiche.

ok donc on change pas ce que je t'ai donner tu n'a rien a faire utilise le tel quel

pour le reste dans le activate pourquoi tu modifie la derniere ligne avec tes controls vides tu te rends bien compte que ca sert a rien ???
ensuite j'avance dans ton code car c'est vrai que l'on a du mal a s y retrouver

alors pour l'evenement t_nomchange() je remplace

ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
If T_nom <> "" Then
        T_date.Enabled = True
        T_extrait.Enabled = True
        Bt2.Enabled = True
        Cbo_search.Enabled = False
        Cbo_sexe.Enabled = True
        Cbo_mat.Enabled = False
        Bt1.Caption = " ENREGISTRER"
        Label17.Caption = "ENREGISTREMENT EN COURS..."
        Label17.ForeColor = vbRed
    Else
        T_date.Enabled = False
        T_extrait.Enabled = False
        Bt2.Enabled = False
        Cbo_search.Enabled = True
        Cbo_sexe.Enabled = False
        Cbo_mat.Enabled = True
        Label17.Caption = "PARTIE ENREGISTREMENT"
        Label17.ForeColor = vbBlack
 
    End If

par cela

Code:

1
2
3
4
5
6
7
8
9
10
11
    T_nom.Text = UCase(T_nom.Text)    ' majuscule automatique
'procédure permettant de dévérouiller les textbox
    T_date.Enabled = T_nom <> ""
    T_extrait.Enabled = T_nom <> ""
    Bt2.Enabled = T_nom <> ""
    Cbo_search.Enabled = T_nom = ""
    Cbo_sexe.Enabled = T_nom <> ""
    Cbo_mat.Enabled = T_nom = ""
    Bt1.Caption = " ENREGISTRER"
    Label17.Caption = IIf(T_nom <> "", "ENREGISTREMENT EN COURS...", "PARTIE ENREGISTREMENT")
    Label17.ForeColor = IIf(T_nom <> "", vbRed, vbBlack)

avoue que l'on y voit plus clair

je continue c'est le foutoir la dedans :mouarf:

23/07/2018, 13h54
Mr l'Ashanti

😂😂😂😂 . Moi même je le savais . Je voulais envoyer mon '' exploit'' à un expert pour apporter son expertise en réduisant les codes. J'avoue que j'étais un peu écrivain quoi😂😂😂😂. Ok merci d'avance. Pouvez vous me laisser votre adresse email après ça.

bon voila j'ai repris tout le code de l'evenement "T_change()"

je vire donc tout ceci

Code:

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
Private Sub T_nom_change() '(1)
'procédure permettant de dévérouiller les textbox
If T_nom <> "" Then
    T_date.Enabled = True
    T_extrait.Enabled = True
    Bt2.Enabled = True
    Cbo_search.Enabled = False
    Cbo_sexe.Enabled = True
    Cbo_mat.Enabled = False
 
Else
    T_date.Enabled = False
    T_extrait.Enabled = False
    Bt2.Enabled = False
    Cbo_search.Enabled = True
    Cbo_sexe.Enabled = False
    Cbo_mat.Enabled = True
 
End If
    T_nom.Text = UCase(T_nom.Text) ' majuscule automatique
If T_nom <> "" Then 'modification du nom Bt1
    Bt1.Caption = " ENREGISTRER"
    Label17.Caption = "ENREGISTREMENT EN COURS..."
    Label17.ForeColor = vbRed
    Else
    Label17.Caption = "PARTIE ENREGISTREMENT"
    Label17.ForeColor = vbBlack
 
  End If
 
If IsNumeric(T_nom.Value) Then 'si valeur numeric then
    Label7.Caption = "VALEUR INTERDITE" ' label change de nom
    Label7.ForeColor = vbRed 'et de couleur
    msgbox "ENTRER DES CARACTERES.MERCI", vbCritical, "MESSAGE D'ERREUR"
    Me.T_nom = "" ' vide le champ apres le message
Else
    Label7.Caption = "NOM & PRENOMS "
    Label7.ForeColor = vbBlue
End If
If Cbo_search.Enabled = False Then 'si la case de la recherche est non vide alors les noms des cases changent
    Label18.Caption = "INACTIF"
    Label14.Caption = "INACTIF"
    Label12.Caption = "INACTIF"
    Label15.Caption = "INACTIF"
    Label13.Caption = "INACTIF"
    Label16.Caption = "INACTIF"
    Label20.Caption = "INACTIF"
    Label21.Caption = "INACTIF"
    Label18.Enabled = False
    Label14.Enabled = False
    Label12.Enabled = False
    Label15.Enabled = False
    Label13.Enabled = False
    Label16.Enabled = False
    Label20.Enabled = False
    Label21.Enabled = False
Else
    Cbo_search.Enabled = True
    Label18.Caption = "NOM & PRENOMS"
    Label14.Caption = "SEXE"
    Label12.Caption = "DATE DE NAISSANCE"
    Label15.Caption = "CLASSE"
    Label13.Caption = "NUMERO D'EXTRAIT"
    Label16.Caption = "STATUT"
    Label20.Caption = "RECHERCHE NOM"
    Label21.Caption = "RECHERCHE NUMERO"
    Label18.Enabled = True
    Label14.Enabled = True
    Label12.Enabled = True
    Label15.Enabled = True
    Label13.Enabled = True
    Label16.Enabled = True
    Label20.Enabled = True
    Label21.Enabled = True
 
End If
    If T_nom = "" Then Label7.ForeColor = vbBlack 'changer de couleur si champ nom est vide
End Sub

QUE JE REMPLACE PAR CELA

Code:

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
 
Private Sub T_nom_change()    '(1)
    Dim sufixe, captions, i&
 
    T_nom.Text = UCase(T_nom.Text)    ' majuscule automatique
'procédure permettant de dévérouiller les textbox
    T_date.Enabled = T_nom <> ""
    T_extrait.Enabled = T_nom <> ""
    Bt2.Enabled = T_nom <> ""
    Cbo_search.Enabled = T_nom = ""
    Cbo_sexe.Enabled = T_nom <> ""
    Cbo_classe.Enabled = T_nom <> ""
    Cbo_statut.Enabled = T_nom <> ""
 
    Cbo_mat.Enabled = T_nom = ""
    Bt1.Caption = " ENREGISTRER"
    Label17.Caption = IIf(T_nom <> "", "ENREGISTREMENT EN COURS...", "PARTIE ENREGISTREMENT")
    Label17.ForeColor = IIf(T_nom <> "", vbRed, vbBlack)
    If IsNumeric(T_nom.Value) Then    'si valeur numeric then
        Label7.Caption = "VALEUR INTERDITE"    ' label change de nom
        Label7.ForeColor = vbRed    'et de couleur
        beep
        msgbox "ENTRER DES CARACTERES.MERCI", , "MESSAGE D'ERREUR"
        Me.T_nom = ""    ' vide le champ apres le message
    Else
        Label7.Caption = "NOM & PRENOMS "
        Label7.ForeColor = vbBlue
    End If
    'bloquage ou debloquage de l'interface du bas
    sufixe = Array("12", "13", "14", "15", "16", "18", "20", "21")
    captions = Array("DATE DE NAISSANCE", "NUMERO D'EXTRAIT", "SEXE", "CLASSE", "STATUT", "NOM & PRENOMS", "RECHERCHE NUMERO", "RECHERCHE NUMERO")
    For i = 0 To UBound(sufixe)
        With Me.Controls("LaBel" & sufixe(i))
            .Caption = IIf(T_nom = "", captions(i), "INACTIF")
            .Enabled = T_nom = ""
        End With
    Next
    If T_nom = "" Then Label7.ForeColor = vbBlack    'changer de couleur si champ nom est vide
End Sub

je continu dans les meandres de ton codes ;)

25/07/2018, 12h12
Mr l'Ashanti

Problème résolu. Merci à tous ceux qui m'ont aidé de près et de loin en pensée et en action. Cordialement
'' le bon sens est la chose au monde le mieux partagé''