Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Access > IHM
IHM Ce forum est dédié aux questions relatives à la création de formulaires et d'états, avec ou sans code VBA, et macros.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 30/09/2011, 11h10   #1
Membre régulier
 
Inscription : juillet 2010
Messages : 230
Détails du profil
Informations forums :
Inscription : juillet 2010
Messages : 230
Points : 82
Points : 82
Par défaut Probleme avec saisie date. Suppression lors de la réouverture du sous form

Bonjour

Je suis confronté à un problème assez bizarre et que je n'arrive pas à régler d'ou cette création de post...

Ma situation : j'ai un formulaire qui contient des onglets. Dans chaque onglet un sous formulaire. Parmais mes 5 onglets j'en ai un ou il est necessaire d'entrer des dates. J'ai donc des txtbox qui ont comme source les champs date de ma table mais également des masques de saisies.

Le problème : Lorsque les dates sont rentrées, il n'y a pas de soucis je les voient bien enregistré dans la table. lorsque je change d'onglet puis que je reviens dessus, elle sont toujours présente. Ca c'est OK.
Mon soucis arrive lorsque le formulaire principal (qui contient les onglets et sous form) doit être fermé. Lorsque je le réouvre (sur le bon ID pour bien retrouver mes données préalablement enregistrées) il affiche un premier onglet parmis les 5 (par défaut). je me rend alors sur l'onglet ou il y a les txbox contenant les dates et elle n'y sont plus. Les champs date de ma table sont également redevenu vide. La ou c'est bizarre c'est que si je réouvre mon formulaire et que je vais sur un autre onglet rien à bougé et ma table contient toujours les dates !!

Pour être un peu plus clair, je me suis aperççu que quand je donne le focus à mon sous formulaire ou se trouve mes textbox avec les dates c'est à ce moment là qu'elle s'efface. si apres réouverture de mon formulaire principal, je navique sur tout les onglets exepté celui avec les dates, je consate qu'elle sont toujours présente dans ma table. Ce n'est donc pas à la réouverture du formulaire qu'elle s'effaceraient mais bien lorsque je donne le focus à ce sous form

Ma question est donc de savoir pourquoi mes textbox se vide comme cela sachant que je n'ai pas de requête mise à jour sur ces champs, que les autres données de ce sous formulaire sont toujours présente, bref cela ne se passe que pour les dates.

pas facile d'expliquer clairement mais si quelqu'un a une solution ! ca m'aidera énormément !! Merci
Chagui est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 03/10/2011, 16h58   #2
Membre Expert
 
Homme Robert JAMIN
Retraité
Inscription : juillet 2009
Messages : 1 223
Détails du profil
Informations personnelles :
Nom : Homme Robert JAMIN
Âge : 73
Localisation : Belgique

Informations professionnelles :
Activité : Retraité
Secteur : Enseignement

Informations forums :
Inscription : juillet 2009
Messages : 1 223
Points : 2 022
Points : 2 022
Bonjour,

Pour vous aider il faudrait que vous puissiez mettre la base de données à disposition avec des données inventées, pour qu'on puisse voir ce qui ce passe, car ce que vous expliquez est étrange et peu habituel.
__________________
Cordialement.

RJ
rjamin est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 04/10/2011, 09h30   #3
Membre régulier
 
Inscription : juillet 2010
Messages : 230
Détails du profil
Informations forums :
Inscription : juillet 2010
Messages : 230
Points : 82
Points : 82
Bonjour,

Merci d'avoir pris le temps de répondre... J'ai finalement trouvé hier après midi le pourquoi de ce drole de problème. Sans rentrer dans les détails, mon form pricnipal et mes sous formulaires sont bien + complexe dans leur conception que ce j'ai expliqué dans le message ci dessus.


En gros mes formulaires fonctionnent comme ceci pou récupérer les données saisies (txtbox, chk..;etc) :

Citation:
Le principe est d’utiliser une convention de nommage sur les contrôles cases à cocher.
Par exemple pour la case OK du libellé n°75 : chk_OK_075

Ensuite, sur validation de la saisie :

Dans une boucle qui balaye tous les contrôles du formulaire, on s’arrête sur les contrôles qui commencent par "chk".

Voir FAQ : Comment énumérer les contrôles d'un formulaire dans une boucle ?

On récupère la case et le numéro du point de contrôle avec des fonctions de manipulation de chaînes de caractères, la valeur de la case avec (Ctrl.value) .
Ensuite tu as toutes les données (numéro du dossier, numéro du point de contrôle, case et valeur de la case) pour insérer/modifier la ligne correspondante dans la table T_ResultatControle (via les fameux RecordSet).

Voir aussi sur le même principe dans la FAQ >Formulaires> Contrôles:
cf : Post ancien ICI

Bref, parmis le long code qui compose chaque sous form, je croyais que lorsque qu'il était réouvert, seulement une fonction précise était appelée mais ce n'étais pas le cas... Une autre fonction était également appelé et effectivement, les txtbox contenant les dates repassaient à null.... (pour faire simple)

Je poste mon code si il y a des curieux... Réalisé grâce à f-leb et LedZeppII qui en + de ce code génial, m'ont énormément aidé tout au long du développement de mon application. je leurs suis grandement reconnaissant pour tous ce qu'ils ont fait !

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
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
'***************************************************************************************
'*                                SOUS FORMULAIRE DATE EFFET                           *
'***************************************************************************************
 
Option Compare Database
Option Explicit
 
' Source :
' SELECT T_controle.IDcontroledossier, T_controle.IDdossier, T_dossiers.[N° de DOSSIER PRESTA/PRESTO]
' FROM T_dossiers INNER JOIN T_controle ON T_dossiers.IDdossier = T_controle.IDdossier;
'
' Clé Source:
' T_controle.IDcontroledossier
'
' Source données des contrôles indépendants :
' T_Resultatcontrole WHERE IDcontroledossier = IDcontroledossier de la source du formulaire
' Clé ligne : IDcontroledossier, IDlibPtCtrl
 
 
' Convention Nom des contrôles gérés par code :  PFX_ID_COLONNE
Const P_PFX = 0        ' Prefixe
Const P_ID = 1         ' ID libellé
Const P_COLONNE = 2    ' Nom Colonne/Champ (OK, KO, IDOC, ...)
' PFX:
' chk_ case à cocher
' txt_ zone de texte
' cbo_ zone de liste modifiable (déouroulante)
'
Const CHKCTLS = "Concerne;OK;KO;IDOC;INONFI;IFI;RFI"
Private Enum enmCHKS
    Concerne = 0
    Ok
    Ko
    IDOC
    INONFI
    IFI
    RFI
End Enum
 
' -----------------------------------------------------------------------------
' Fonction appelé sur l'évènement Sur clic de chaque case à cocher
' -----------------------------------------------------------------------------
Function DonneesModifiees()
 
    Dim arrPartiesControle() As String
    Dim NumCtrldossier As Long, NumlibPtCtrl As Long
    Dim strNomChamp As String
 
    NumCtrldossier = Me.IDcontroledossier
    arrPartiesControle = Split(Me.ActiveControl.Name, "_")
    NumlibPtCtrl = CLng(arrPartiesControle(P_ID))
    strNomChamp = arrPartiesControle(P_COLONNE)
 
    ' Un choix parmis (INONFI,IFI,RFI)
    If Me.ActiveControl.Value = True Then
        Select Case strNomChamp
        Case "INONFI"
            Me.Controls("chk_" & NumlibPtCtrl & "_IFI").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_RFI").Value = False
        Case "IFI"
            Me.Controls("chk_" & NumlibPtCtrl & "_INONFI").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_RFI").Value = False
        Case "RFI"
            Me.Controls("chk_" & NumlibPtCtrl & "_INONFI").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_IFI").Value = False
        Case "OK"
            Me.Controls("chk_" & NumlibPtCtrl & "_KO").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_KO").Locked = False
            Me.Controls("chk_" & NumlibPtCtrl & "_OK").Locked = True
            Me.Controls("chk_" & NumlibPtCtrl & "_IDOC").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_IFI").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_INONFI").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_RFI").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_IDOC").Visible = True
            Me.Controls("chk_" & NumlibPtCtrl & "_IFI").Visible = True
            Me.Controls("chk_" & NumlibPtCtrl & "_INONFI").Visible = True
            Me.Controls("chk_" & NumlibPtCtrl & "_RFI").Visible = True
            Me.Controls("chk_" & NumlibPtCtrl & "_IDOC").Enabled = False
            Me.Controls("chk_" & NumlibPtCtrl & "_IFI").Enabled = False
            Me.Controls("chk_" & NumlibPtCtrl & "_INONFI").Enabled = False
            Me.Controls("chk_" & NumlibPtCtrl & "_RFI").Enabled = False
            Me.Controls("chk_" & NumlibPtCtrl & "_IDOC").Locked = False
            Me.Controls("chk_" & NumlibPtCtrl & "_IFI").Locked = False
            Me.Controls("chk_" & NumlibPtCtrl & "_INONFI").Locked = False
            Me.Controls("chk_" & NumlibPtCtrl & "_RFI").Locked = False
            Me.Controls("cbo_" & NumlibPtCtrl & "_Motifs").Enabled = False
            Me.Controls("txt_" & NumlibPtCtrl & "_Commentaire").Enabled = False
 
        Case "KO"
            Me.Controls("chk_" & NumlibPtCtrl & "_OK").Value = False
            Me.Controls("chk_" & NumlibPtCtrl & "_OK").Locked = False
            Me.Controls("chk_" & NumlibPtCtrl & "_KO").Locked = True
        End Select
    End If
 
    ' Activer/Desactiver contrôles
    CtleCasesLigne NumlibPtCtrl
    ' Enregistrer la ligne du Point de contrôle
    EnregistrerLigne NumCtrldossier, NumlibPtCtrl
 
End Function
 
' -----------------------------------------------------------------------------
' Fonction appelé sur l'évènement Après MAJ de chaque zone de texte "commentaire"
' -----------------------------------------------------------------------------
Function DonneesModifieesCboTxt()
 
    Dim arrPartiesControle() As String
    Dim NumCtrldossier As Long, NumlibPtCtrl As Long
    Dim strNomChamp As String
 
    NumCtrldossier = Me.IDcontroledossier
    arrPartiesControle = Split(Me.ActiveControl.Name, "_")
    NumlibPtCtrl = CLng(arrPartiesControle(P_ID))
    strNomChamp = arrPartiesControle(P_COLONNE)
 
    ' Enregistrer la ligne du Point de contrôle
    EnregistrerLigne NumCtrldossier, NumlibPtCtrl
 
End Function
 
' -----------------------------------------------------------------------------
' Initialisation des lignes au chargement du sous formulaire
' -----------------------------------------------------------------------------
Sub InitialiserLblLignes()
 
    Dim ctl As Access.Control
    Dim strIdlibelle As String
    For Each ctl In Me.Controls
        If ctl.Name Like "lblLigne_*" Then
            strIdlibelle = Replace(ctl.Name, "lblLigne_", "")
            ctl.Caption = DLookup("Nomlibelles", "T_libelles", "IDlibelles=" & strIdlibelle)
        End If
    Next
 
End Sub
 
' -----------------------------------------------------------------------------
' Lecture des enregistrements (points de contrôles)
' et affectation des valeurs aux contrôles indépendants.
' -----------------------------------------------------------------------------
Public Sub LireDonnees(NumCtrldossier As Long)
 
    Dim db As DAO.Database, Rs As Recordset
    Dim strSql As String
    Dim strNomChamp As String, strNomCtl As String
 
    On Error GoTo ErrLireDonnees
 
    Set db = CurrentDb
    strSql = "SELECT * FROM [T_Resultatcontrole] WHERE [IDcontroledossier]=" & NumCtrldossier
    Set Rs = db.OpenRecordset(strSql)
    Do While Not Rs.EOF
    '
        strNomChamp = "Concerne"
        strNomCtl = "chk_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "OK"
        strNomCtl = "chk_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "KO"
        strNomCtl = "chk_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "IDOC"
        strNomCtl = "chk_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "INONFI"
        strNomCtl = "chk_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "IFI"
        strNomCtl = "chk_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "RFI"
        strNomCtl = "chk_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "Motifs"
        strNomCtl = "cbo_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
    '
        strNomChamp = "Commentaire"
        strNomCtl = "txt_" & Rs("IDlibPtCtrl") & "_" & strNomChamp
        Me.Controls(strNomCtl) = Rs(strNomChamp)
 
        CtleCasesLigne Rs("IDlibPtCtrl")
 
        Rs.MoveNext
    Loop
    Rs.Close
    Exit Sub
 
ErrLireDonnees:
    Select Case Err.Number
    Case 2465, 3265    ' Champ, Contrôle n'existe pas
        Resume Next
    End Select
 
    MsgBox "Erreur N." & Err.Number & " : " & Err.description
 
End Sub
 
' -----------------------------------------------------------------------------
' Enregistrement dans la table des valeurs des contrôles indépendants
' de tous les points de contrôles.
' -----------------------------------------------------------------------------
Public Sub EnregistrerDonnees(NumCtrldossier As Long)
 
    Dim db As DAO.Database, Rs As Recordset
    Dim strSql As String
    Dim strNomChamp As String, strNomCtl As String
    Dim NumlibPtCtrl As Long
 
    On Error GoTo ErrEnregistrerDonneesDonnees
 
    Set db = CurrentDb
    strSql = "SELECT * FROM [T_Resultatcontrole] WHERE [IDcontroledossier]=" & NumCtrldossier
    Set Rs = db.OpenRecordset(strSql)
    Do While Not Rs.EOF
        NumlibPtCtrl = Rs("IDlibPtCtrl")
        Rs.Edit
    '
        strNomChamp = "Concerne"
        strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "OK"
        strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "KO"
        strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "IDOC"
        strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "INONFI"
        strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "IFI"
        strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "RFI"
        strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "Motifs"
        strNomCtl = "cbo_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
    '
        strNomChamp = "Commentaire"
        strNomCtl = "txt_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
 
        Rs.Update
        Rs.MoveNext
    Loop
    Rs.Close
    Exit Sub
 
ErrEnregistrerDonneesDonnees:
    Select Case Err.Number
    Case 2465, 3265    ' Champ, Contrôle n'existe pas
        Resume Next
    End Select
 
    MsgBox "Erreur N." & Err.Number & " : " & Err.description, , _
           "IDcontroledossier " & NumCtrldossier & " , NumlibPtCtrl " & NumlibPtCtrl
 
End Sub
 
' -----------------------------------------------------------------------------
' Enregistrement dans la table des valeurs des contrôles indépendants
' d'un point de contrôle.
' -----------------------------------------------------------------------------
Sub EnregistrerLigne(NumCtrldossier As Long, NumlibPtCtrl As Long)
 
    Dim db As DAO.Database, Rs As Recordset
    Dim strSql As String
    Dim strNomChamp As String, strNomCtl As String
    Dim arrChamps() As String, i As Long
    Dim strStep As String, lgRetVal As Long
    Dim strErrMsgTitle As String
 
    strSql = "SELECT * FROM T_Resultatcontrole " & _
             "WHERE IDcontroledossier=" & NumCtrldossier & " AND " & _
             "IDlibPtCtrl=" & NumlibPtCtrl
 
    Set db = CurrentDb
    Set Rs = db.OpenRecordset(strSql)
    If Not Rs.EOF Then
        arrChamps = Split(CHKCTLS, ";")
EnregisterEnrRetry:
        strStep = "EDIT"
        Rs.Edit
 
        For i = LBound(arrChamps) To UBound(arrChamps)
            strNomChamp = arrChamps(i)
            strNomCtl = "chk_" & NumlibPtCtrl & "_" & strNomChamp
            Rs(strNomChamp) = Me.Controls(strNomCtl)
        Next
 
        strNomChamp = "Motifs"
        strNomCtl = "cbo_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
 
        strNomChamp = "Commentaire"
        strNomCtl = "txt_" & NumlibPtCtrl & "_" & strNomChamp
        Rs(strNomChamp) = Me.Controls(strNomCtl)
 
        strStep = "SAVE"
        Rs.Update
    End If
 
    Rs.Close
    Exit Sub
 
ErrEnregisterEnr:
    Select Case strStep
    Case "EDIT"
        strErrMsgTitle = "Modification Enregistrement"
    Case "SAVE"
        strErrMsgTitle = "Sauvegarde Enregistrement"
        Rs.CancelUpdate
    Case Else
        strErrMsgTitle = "IDcontroledossier " & NumCtrldossier & " , NumlibPtCtrl " & NumlibPtCtrl
    End Select
    lgRetVal = MsgBox("Erreur " & Err.Number & " : " & Err.description, vbRetryCancel, strErrMsgTitle)
    If lgRetVal = vbRetry Then
        Resume EnregisterEnrRetry
    End If
 
End Sub
 
' -----------------------------------------------------------------------------
' Gère le comportement des contrôles (cases, txtbox, listbox) pour chaque ligne.
' -----------------------------------------------------------------------------
Sub CtleCasesLigne(NumlibPtCtrl As Long)
 
    Dim arrChamps() As String
    Dim chkID As enmCHKS
    Dim arrChks() As Access.CheckBox
    Dim actCtl As Access.Control
    Dim bLibExsite As Boolean
 
    On Error GoTo ErrCtleCasesLigne
 
    arrChamps = Split(CHKCTLS, ";")
 
    ' Vérifie que 1er contrôle (chk_nn_Concerne) existe
    ' S'il n'existe pas une erreur est levée et bLibExsite reste à Fale
    bLibExsite = Me.Controls("chk_" & NumlibPtCtrl & "_" & arrChamps(enmCHKS.Concerne)).Visible
    If bLibExsite = False Then Exit Sub
 
    ReDim arrChks(enmCHKS.Concerne To enmCHKS.RFI)
    For chkID = Concerne To RFI
        Set arrChks(chkID) = Me.Controls("chk_" & NumlibPtCtrl & "_" & arrChamps(chkID))
    Next
 
    Set actCtl = Me.ActiveControl
    arrChks(enmCHKS.Concerne).SetFocus
    If actCtl Is Nothing Then Set actCtl = Me.ActiveControl
 
    ' Par défaut on désactive tout
    For chkID = enmCHKS.Ok To enmCHKS.RFI
        arrChks(chkID).Enabled = False
    Next
    Me.Controls("cbo_" & NumlibPtCtrl & "_Motifs").Enabled = False
    Me.Controls("txt_" & NumlibPtCtrl & "_Commentaire").Enabled = False
 
    ' Concerné, si cochée
    If arrChks(enmCHKS.Concerne).Value = True Then
        arrChks(enmCHKS.Ok).Enabled = True
        arrChks(enmCHKS.Ko).Enabled = True
    End If
 
    ' Concerné, si décochée
    If arrChks(enmCHKS.Concerne).Value = False Then
        For chkID = enmCHKS.IDOC To enmCHKS.RFI
            arrChks(chkID).Value = False
            arrChks(chkID).Visible = True
            arrChks(chkID).Enabled = False
            arrChks(chkID).Locked = False
        Next
        arrChks(enmCHKS.Ok).Value = False
        arrChks(enmCHKS.Ko).Value = False
        arrChks(enmCHKS.Ok).Enabled = False
        arrChks(enmCHKS.Ko).Enabled = False
        arrChks(enmCHKS.Ok).Locked = False
        arrChks(enmCHKS.Ko).Locked = False
        Me.Controls("cbo_" & NumlibPtCtrl & "_Motifs").Value = Null
        Me.Controls("txt_" & NumlibPtCtrl & "_Commentaire").Value = Null
    End If
 
    ' KO, si cochée
    If arrChks(enmCHKS.Ko).Value = True Then
        For chkID = enmCHKS.IDOC To enmCHKS.RFI
            arrChks(chkID).Enabled = True
        Next
        Me.Controls("cbo_" & NumlibPtCtrl & "_Motifs").Enabled = True
        Me.Controls("txt_" & NumlibPtCtrl & "_Commentaire").Enabled = True
    End If
 
    ' KO, si décochée
    If arrChks(enmCHKS.Ko).Value = False Then
        Me.Controls("cbo_" & NumlibPtCtrl & "_Motifs").Value = Null
        Me.Controls("txt_" & NumlibPtCtrl & "_Commentaire").Value = Null
    End If
 
    ' NIR
    If NumlibPtCtrl = 4 Then
    If chk_4_KO.Value = True Then
        chk_4_IDOC.Value = True
        chk_4_IDOC.Locked = True
        chk_4_INONFI.Visible = False
        chk_4_IFI.Visible = False
        chk_4_RFI.Visible = False
    End If
    End If
 
    ' Date d'effet X1
    If NumlibPtCtrl = 5 Then
    If chk_5_KO.Value = True Then
        chk_5_IFI.Value = True
        chk_5_IDOC.Visible = False
        chk_5_INONFI.Visible = False
        chk_5_IFI.Locked = True
        chk_5_RFI.Visible = False
        DEDB.Locked = False
        DEDB.Enabled = True
    End If
 
    If chk_5_OK = True Then
        DEDB.Value = Null
        DEDB.Locked = True
        DEDB.Enabled = False
    End If
 
    If chk_5_Concerne = False Then
        DEDB.Value = Null
        DEDB.Locked = True
        DEDB.Enabled = False
    End If
    End If
 
    ' Date d'effet X2
    If NumlibPtCtrl = 6 Then
    If chk_6_KO.Value = True Then
        chk_6_IFI.Value = True
        chk_6_IDOC.Visible = False
        chk_6_INONFI.Visible = False
        chk_6_IFI.Locked = True
        chk_6_RFI.Visible = False
        DEDC.Locked = False
        DEDC.Enabled = True
    End If
 
    If chk_6_OK = True Then
        DEDC.Value = Null
        DEDC.Locked = True
        DEDC.Enabled = False
    End If
 
 
    If chk_6_Concerne = False Then
        DEDC.Value = Null
        DEDC.Locked = True
        DEDC.Enabled = False
    End If
    End If
 
   ' Date demande X3
   If NumlibPtCtrl = 7 Then
    If chk_7_KO.Value = True Then
        chk_7_IDOC.Visible = False
        chk_7_RFI.Visible = False
        DateDem.Locked = False
        DateDem.Enabled = True
    End If
 
    If chk_7_OK = True Then
        DateDem.Value = Null
        DateDem.Locked = True
        DateDem.Enabled = False
    End If
 
    If chk_7_Concerne = False Then
        DateDem.Value = Null
        DateDem.Locked = True
        DateDem.Enabled = False
    End If
    End If
 
    ' Date de naissance demandeur
    If NumlibPtCtrl = 8 Then
    If chk_8_KO.Value = True Then
        chk_8_IDOC.Visible = False
        chk_8_RFI.Visible = False
        DateNaiss.Locked = False
        DateNaiss.Enabled = True
    End If
 
    If chk_8_OK = True Then
        DateNaiss.Value = Null
        DateNaiss.Locked = True
        DateNaiss.Enabled = False
    End If
 
    If chk_8_Concerne = False Then
        DateNaiss.Value = Null
        DateNaiss.Locked = True
        DateNaiss.Enabled = False
    End If
    End If
 
    ' Date d'effet X4
    If NumlibPtCtrl = 9 Then
    If chk_9_KO.Value = True Then
        chk_9_IFI.Value = True
        chk_9_IDOC.Visible = False
        chk_9_INONFI.Visible = False
        chk_9_IFI.Locked = True
        chk_9_RFI.Visible = False
        DEMTP.Locked = False
        DEMTP.Enabled = True
    End If
 
    If chk_9_OK = True Then
        DEMTP.Value = Null
        DEMTP.Locked = True
        DEMTP.Enabled = False
    End If
 
    If chk_9_Concerne = False Then
        DEMTP.Value = Null
        DEMTP.Locked = True
        DEMTP.Enabled = False
    End If
    End If
 
    ' Date d'effet X5
    If NumlibPtCtrl = 10 Then
    If chk_10_KO.Value = True Then
        chk_10_IFI.Value = True
        chk_10_IDOC.Visible = False
        chk_10_INONFI.Visible = False
        chk_10_IFI.Locked = True
        chk_10_RFI.Visible = False
        DERC.Locked = False
        DERC.Enabled = True
    End If
 
    If chk_10_OK = True Then
        DERC.Value = Null
        DERC.Locked = True
        DERC.Enabled = False
    End If
 
    If chk_10_Concerne = False Then
        DERC.Value = Null
        DERC.Locked = True
        DERC.Enabled = False
    End If
    End If
 
    ' Date d'effet X6
    If NumlibPtCtrl = 151 Then
    If chk_151_KO.Value = True Then
        chk_151_IFI.Value = True
        chk_151_IDOC.Visible = False
        chk_151_INONFI.Visible = False
        chk_151_IFI.Locked = True
        chk_151_RFI.Visible = False
        DEATC.Locked = False
        DEATC.Enabled = True
    End If
 
    If chk_151_OK = True Then
        DEATC.Value = Null
        DEATC.Locked = True
        DEATC.Enabled = False
    End If
 
    If chk_151_Concerne = False Then
        DEATC.Value = Null
        DEATC.Locked = True
        DEATC.Enabled = False
    End If
    End If
 
 
 
    If actCtl.Enabled Then actCtl.SetFocus
 
ExitCtleCasesLigne:
    Exit Sub
 
ErrCtleCasesLigne:
    Select Case Err.Number
    Case 2474    ' L'expression entrée requiert que le contrôle se trouve dans la fenêtre active.
        Resume Next
    Case 2465, 3265    ' Champ, Contrôle n'existe pas
        Resume Next
    End Select
 
    MsgBox "Erreur N." & Err.Number & " : " & Err.description, , _
           "NumlibPtCtrl " & NumlibPtCtrl
    Resume ExitCtleCasesLigne
 
End Sub
 
Private Sub Form_Load()
 
    InitialiserLblLignes
 
    If (Me.chk_5_KO.Value = True) Then
        DEDB.Locked = False
    Else
        DEDB.Locked = True
    End If
    If Me.chk_6_KO.Value = True Then
        DEDC.Locked = False
    Else
        DEDC.Locked = True
    End If
    If Me.chk_10_KO.Value = True Then
        DERC.Locked = False
    Else
        DERC.Locked = True
    End If
    If Me.chk_9_KO.Value = True Then
        DEMTP.Locked = False
    Else
        DEMTP.Locked = True
    End If
    If Me.chk_7_KO.Value = True Then
        DateDem.Locked = False
    Else
        DateDem.Locked = True
    End If
    If Me.chk_8_KO.Value = True Then
        DateNaiss.Locked = False
    Else
        DateNaiss.Locked = True
    End If
 
    If Me.chk_151_KO.Value = True Then
        DEATC.Locked = False
    Else
        DEATC.Locked = True
    End If
 
End Sub
 
' -----------------------------------------------------------------------------
' Sur fermeture du sous formulaire
' -----------------------------------------------------------------------------
Private Sub Form_Close()
 
    DoCmd.SetWarnings False
 
    If Me.chk_5_KO = True Then    
        DoCmd.RunSQL "UPDATE T_Resultatcontrole INNER JOIN T_controle" _
        & " ON T_Resultatcontrole.IDcontroledossier=T_controle.IDcontroledossier" _
        & " SET T_Resultatcontrole.Commentaire= T_controle.NouvelleDateEffetDB" _
        & " WHERE T_Resultatcontrole.IDlibPtCtrl=5" _
        & " AND T_Resultatcontrole.IDcontroledossier=" & Me.IDcontroledossier
    End If
 
    If Me.chk_6_KO = True Then  
        DoCmd.RunSQL "UPDATE T_Resultatcontrole INNER JOIN T_controle" _
        & " ON T_Resultatcontrole.IDcontroledossier=T_controle.IDcontroledossier" _
        & " SET T_Resultatcontrole.Commentaire= T_controle.NouvelleDateEffetDC" _
        & " WHERE T_Resultatcontrole.IDlibPtCtrl=6" _
        & " AND T_Resultatcontrole.IDcontroledossier=" & Me.IDcontroledossier
    End If
 
    If Me.chk_7_KO = True Then    
        DoCmd.RunSQL "UPDATE T_Resultatcontrole INNER JOIN T_controle" _
        & " ON T_Resultatcontrole.IDcontroledossier=T_controle.IDcontroledossier" _
        & " SET T_Resultatcontrole.Commentaire= T_controle.[Date demande]" _
        & " WHERE T_Resultatcontrole.IDlibPtCtrl=7" _
        & " AND T_Resultatcontrole.IDcontroledossier=" & Me.IDcontroledossier
    End If
 
    If Me.chk_8_KO = True Then    
        DoCmd.RunSQL "UPDATE T_Resultatcontrole INNER JOIN T_controle" _
        & " ON T_Resultatcontrole.IDcontroledossier=T_controle.IDcontroledossier" _
        & " SET T_Resultatcontrole.Commentaire= T_controle.[Date naissance demandeur]" _
        & " WHERE T_Resultatcontrole.IDlibPtCtrl=8" _
        & " AND T_Resultatcontrole.IDcontroledossier = " & Me.IDcontroledossier
    End If
 
    If Me.chk_9_KO = True Then   
        DoCmd.RunSQL "UPDATE T_Resultatcontrole INNER JOIN T_controle" _
        & " ON T_Resultatcontrole.IDcontroledossier=T_controle.IDcontroledossier" _
        & " SET T_Resultatcontrole.Commentaire= T_controle.NouvelleDateEffetMTP" _
        & " WHERE T_Resultatcontrole.IDlibPtCtrl=9" _
        & " AND T_Resultatcontrole.IDcontroledossier = " & Me.IDcontroledossier
    End If
 
        If Me.chk_10_KO = True Then    
        DoCmd.RunSQL "UPDATE T_Resultatcontrole INNER JOIN T_controle" _
        & " ON T_Resultatcontrole.IDcontroledossier=T_controle.IDcontroledossier" _
        & " SET T_Resultatcontrole.Commentaire= T_controle.NouvelleDateEffetEXRC" _
        & " WHERE T_Resultatcontrole.IDlibPtCtrl=10" _
        & " AND T_Resultatcontrole.IDcontroledossier = " & Me.IDcontroledossier
    End If
 
        If Me.chk_151_KO = True Then    'Date d'effet Conjoint
        DoCmd.RunSQL "UPDATE T_Resultatcontrole INNER JOIN T_controle" _
        & " ON T_Resultatcontrole.IDcontroledossier=T_controle.IDcontroledossier" _
        & " SET T_Resultatcontrole.Commentaire= T_controle.NouvelleDateEffetConjoint" _
        & " WHERE T_Resultatcontrole.IDlibPtCtrl=151" _
        & " AND T_Resultatcontrole.IDcontroledossier = " & Me.IDcontroledossier
    End If
 
    DoCmd.SetWarnings True
 
End Sub
A bientôt !
Chagui est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 03h36.


 
 
 
 
Partenaires

Hébergement Web