IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Access Discussion :

Problèmes avec création d'une série de test dans une table


Sujet :

Access

  1. #1
    Provisoirement toléré Avatar de charleshbo
    Profil pro
    Inscrit en
    Janvier 2006
    Messages
    222
    Détails du profil
    Informations personnelles :
    Âge : 38
    Localisation : France

    Informations forums :
    Inscription : Janvier 2006
    Messages : 222
    Points : 125
    Points
    125
    Par défaut Problèmes avec création d'une série de test dans une table
    C'est aujourd'hui le troisième jour que je travaille sur ce même bug. Je travaille dans une usine de production de tuyaux de caoutchouc et nous avons un programme qui génère une liste de test a effectuer sur les boyaux lorsque nous créons un nouveau contrat.

    Le problème est que dans les opérations (que je trace sans arrêts depuis 3 jours pour trouver quoi faire) duplique certains enregistrement et en oublie certains... je sais pas comment vous pourrez m'aider dans cela, mais j'espère qu'en postant ce bout de code, que peut-être vous pourrez m'aider à résoudre ce problème.

    Voici le code qui est appelé lorsqu'on clique sur le bouton.
    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
     
    Private Sub btnResultat_Click()
    Dim code1 As String, code2 As String, code3 As String, Mcx1 As String, Mcx2 As String, Mcx3 As String
    Dim rstEchantillon As Recordset
    Dim toto As Boolean
    Dim db As Database
    Set db = CurrentDb
    If MsgBox("Si vous continuez, les resultats seront cree mais les echantillons ne seront plus disponible pour l'impression dans cet ecran. Voulez-vous continuer ?", vbYesNo) = vbYes Then
    Else
        Exit Sub
    End If
    If IsNull(lstNoIdent.Value) = True Then
        MsgBox "Veuillez choisir un # de contrat", vbCritical
        Exit Sub
    End If
    If IsNull(Form_InfoProduit.SPECGRANF.Value) = True Then
        MsgBox "Veuillez sélectionner un produit dans la 'Liste des produits du contrat'", vbCritical
        Exit Sub
    End If
    Set rstEchantillon = db.OpenRecordset("select * from gf_Echant where  noident = '" & lstNoIdent.Value & "' and (nospec = '" & Liste10.Column(0) & "' and (cstr(datelivr)= '" & Liste10.Column(1) & "' or cstr(datelivr)= '12:00:00 AM'or cstr(datelivr)= '00:00:00') and codeactiv is not null and nbre_long_test is not null) and ( cochelabo1 = -1 or cochetest1 = -1 or cochetest2 = -1  or cochetest3 = -1 or cocheext1 = -1 )and  gf_echant.nocarte  in (select nocarte from req_echant)", dbOpenDynaset)
    'Set rstEchantillon = db.OpenRecordset("select * from gf_echant where  noident = '" & lstNoIdent.Value & "' and nospec = '" & Liste10.Column(0) & "' and ( cstr(datelivr) = '" & CStr(Liste10.Column(1)) & "' or cstr(datelivr) = '12:00:00 AM' or cstr(datelivr) ='00:00:00' ) and  gf_echant.nocarte  in (select nocarte from req_echant) "
    'and  gf_echant.nocarte  in (select nocarte from req_echant)
    toto = False
    While Not rstEchantillon.EOF
        toto = True
        code2 = ""
        code3 = ""
        Mcx2 = ""
        Mcx3 = ""
        If IsNull(rstEchantillon.Fields("codeactiv2")) = True Then
            code2 = ""
        Else
            code2 = rstEchantillon.Fields("codeactiv2")
        End If
        If IsNull(rstEchantillon.Fields("codeactiv3")) = True Then
            code3 = ""
        Else
            code3 = rstEchantillon.Fields("codeactiv3")
        End If
        If IsNull(rstEchantillon.Fields("nbre_long_test2").Value) Then
            Mcx2 = ""
        Else
            Mcx2 = rstEchantillon.Fields("nbre_long_test2").Value
        End If
        If IsNull(rstEchantillon.Fields("nbre_long_test3").Value) Then
            Mcx3 = ""
        Else
            Mcx3 = rstEchantillon.Fields("nbre_long_test3").Value
        End If
     
    Dim rstEchan As Recordset
    Set rstEchan = CurrentDb.OpenRecordset(Form_InfoEchant.RecordSource, dbOpenDynaset)
     
     
     
    creerResultat rstEchantillon.Fields("nocarte").Value, rstEchantillon.Fields("noident").Value, rstEchantillon.Fields("codeactiv").Value, rstEchantillon.Fields("nbre_long_test").Value, code2, code3, Mcx2, Mcx3
     
    '*************************************************Garder juste les tests appropriés****************************************************************************
        While Not rstEchan.EOF
            If rstEchan.Fields("cocheTest1") = -1 And rstEchan.Fields("cocheLabo1") = -1 Then
            Else
                    If rstEchan.Fields("cocheTest1") = -1 And rstEchan.Fields("cocheLabo1") = 0 Then
                            CurrentDb.Execute ("DELETE FROM gf_resultat_test WHERE noechantille = '" & rstEchan.Fields("nocarte") & "' and morceau = " & rstEchan.Fields("nbre_long_test") & " and séquence <= 499")
                    Else
                             If rstEchan.Fields("cocheTest1") = 0 And rstEchan.Fields("cocheLabo1") = -1 Then
                                    CurrentDb.Execute ("DELETE FROM gf_resultat_test WHERE noechantille = '" & rstEchan.Fields("nocarte") & "' and morceau = " & rstEchan.Fields("nbre_long_test") & " and séquence >= 500")
                            Else
                                    If rstEchan.Fields("cocheTest1") = 0 And rstEchan.Fields("cocheLabo1") = 0 Then
                                            CurrentDb.Execute ("DELETE FROM gf_resultat_test WHERE noechantille = '" & rstEchan.Fields("nocarte") & "' and morceau = " & rstEchan.Fields("nbre_long_test"))
                                    End If
                            End If
                    End If
            End If
     
    rstEchan.MoveNext
    Wend
     
     
    rstEchan.Close
     
    '*************************************************************************************************************************************************************************
     
        Dim tempo
        tempo = ""
        With rstEchantillon
            If .Fields("cochelabo1").Value = 0 Then
                .Edit
                .Fields("RESULLABO").Value = -1
                .Update
            Else
                .Edit
                .Fields("RESULLABO").Value = 0
                .Update
            End If
     
            If .Fields("cochetest1").Value = 0 Then
                .Edit
                .Fields("RESULtest").Value = -1
                .Update
            Else
                .Edit
                .Fields("RESULtest").Value = 0
                .Update
            End If
        End With
        rstEchantillon.MoveNext
    Wend
     
    If toto = False Then
        MsgBox "Aucun résultat à été créé !", vbCritical
    Else
        Form_InfoEchant.Requery
    End If
    End Sub
    Voici le code de la fonction qui créé les résultats
    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
    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
     
    Public Function creerResultat(NOCARTE As String, NOIDENT As String, code1 As String, Mcx1 As String, Optional code2 As String, Optional code3 As String, Optional Mcx2 As String, Optional Mcx3 As String)
     
    Dim msgnoechant As String, entreenoechant, CHCRITèRE, msgnbmorceau, nbmorceau, morceau
    Dim bds As Database, rstEchant As Recordset, rstTest, rsttestproduit As Recordset, rstProduit
    Dim rstResultat_Echant As Recordset, rstResultat_Morceau, RSTRESULTAT_TEST
    Dim rstContrat As Recordset, rstcode As Recordset
    Dim strproduit As String, strcode As String, FIN, strTypeTest, erreur
    Dim compteur As Integer, msgcontrat, msgproduit, entreecontrat, entreeproduit
    Dim msgcode As String, entreecode, MSGDATELIVR, ENTREEDATELIVR
     
    Dim strNoSpec As String, strNoTest As String, strlocalise As String, strQualite As String
    Dim nCodeActiv As String, strSequence As String, strTypeDeTest As String, strMesure As String
    Dim bPermission As Boolean
    debut:
    Set bds = CurrentDb
    Set rstEchant = bds.OpenRecordset("gf_echant", dbOpenDynaset)
    Set rstTest = bds.OpenRecordset("gf_test", dbOpenDynaset)
    Set rstContrat = bds.OpenRecordset("gf_prodcontrat", dbOpenDynaset)
    Set rsttestproduit = bds.OpenRecordset("gf_prodtest", dbOpenDynaset)
    Set rstcode = bds.OpenRecordset("gf_codes de fréquence", dbOpenDynaset)
    Set rstProduit = bds.OpenRecordset("gf_produit", dbOpenDynaset)
    Set rstResultat_Echant = bds.OpenRecordset("gf_resultat_echant", dbOpenDynaset)
    Set rstResultat_Morceau = bds.OpenRecordset("gf_resultat_morceau", dbOpenDynaset)
    Set RSTRESULTAT_TEST = bds.OpenRecordset("gf_resultat_test", dbOpenDynaset)
     
    msgcode = "Veuillez entrer le code d'activité de l'échantillon!"
    msgcontrat = "Veuillez entrer le numéro de contrat!"
    msgproduit = "Veuillez entrer le numéro de produit!"
    msgnoechant = "Veuillez entrer le numéro d'échantillon!"
    msgnbmorceau = "Veuillez entrer le nombre de morceau!"
    MSGDATELIVR = "Veuillez entrer la date de livraison du client!"
     
    bPermission = True
     
    erreur = "non"
        If Form_Menu.filtrenoechant <> "" Then
            entreenoechant = NOCARTE
        Else
            entreenoechant = NOCARTE
        End If
     
        If entreenoechant <> "" Then
            Form_Menu.filtrenoechant.Value = entreenoechant
            CHCRITèRE = "cstr([noechantille])= '" & entreenoechant & "'"
            rstResultat_Echant.FindFirst CHCRITèRE
            If rstResultat_Echant.NoMatch Then
                CHCRITèRE = "CSTR([NOCARTE]) = '" & entreenoechant & "'"
                rstEchant.FindFirst CHCRITèRE
                If rstEchant.NoMatch Then
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                'AJOUTE ECHANTILLON DANS TABLE éCHANTILLON
                '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    MsgBox "Le numéro de l'échantillon " & entreenoechant & " n'existe pas dans la table échantillon!"
                    entreecontrat = InputBox(msgcontrat, "Contrat")
                    entreeproduit = InputBox(msgproduit, "Produit")
     
                    ENTREEDATELIVR = InputBox(MSGDATELIVR, "Date de livraison")
     
                    If Len(entreeproduit) = 14 Then
                        entreeproduit = Trim(Mid(entreeproduit, 1, 3) + "-" + Mid(entreeproduit, 4, 3) + "-" + Mid(entreeproduit, 7, 3) + "-" + Mid(entreeproduit, 10, 5))
                    End If
     
                    If IsDate(ENTREEDATELIVR) Then
                        CHCRITèRE = "trim(CSTR([NOIDENT])+cstr([spec14])+cstr([datelivr])) = '" & Trim(entreecontrat + entreeproduit + CStr(CDate(ENTREEDATELIVR))) & "'"
                        rstContrat.FindFirst CHCRITèRE
                        If rstContrat.NoMatch Then
                            MsgBox "Le numéro de produit " & entreeproduit & " pour le contrat " & entreecontrat & " n'existe pas dans la table contrat pour la date de livraison " & ENTREEDATELIVR & "!"
                            erreur = "oui"
                        Else
                            entreecode = InputBox(msgcode, "Code d'activité")
                            If entreecode = "" Then
                                MsgBox "L'opération est annulé, aucune entrée!"
                                GoTo line1
                            Else
                                If IsNumeric(entreecode) Then
                                Else
                                    MsgBox "Le code d'activité n'est pas numérique!"
                                    GoTo line1
                                End If
                            End If
     
                            Form_Menu.filtrenoproduit.Value = entreeproduit
                            Form_Menu.filtrenocontrat.Value = entreecontrat
     
                            nbmorceau = InputBox(msgnbmorceau, "Nombre de morceau")
     
                            DoCmd.Hourglass True
     
                            If nbmorceau = "" Then
                                nbmorceau = "1"
                            End If
                            If IsNull(rstContrat!typetest) Then
                                strTypeTest = "603000"
                            Else
                                strTypeTest = rstContrat!typetest
                            End If
                            strproduit = rstContrat.Fields("spec14")
                            CHCRITèRE = "[specgranf]='" & Mid(entreeproduit, 1, 11) & "'"
                            rstProduit.FindFirst CHCRITèRE
                            If rstProduit.NoMatch Then
                                MsgBox "Le numéro de produit " & Mid(entreeproduit, 1, 11) & " n'existe pas dans la table produit!"
                                erreur = "oui"
                            Else
                                If IsNumeric(nbmorceau) Then
                                    With rstEchant
                                    .AddNew
                                    !NOCARTE = entreenoechant
                                    !NOSPEC = entreeproduit
                                    !NOIDENT = entreecontrat
                                    !DATELIVR = CDate(ENTREEDATELIVR)
                                    !RELACHE = -1
                                    !imp_relach = -1
                                    !RESULLABO = -1
                                    !RESULTEST = -1
                                    If IsNull(entreecode) Then
                                    Else
                                    If IsNumeric(entreecode) Then
                                    !CODEACTIV = entreecode
                                    Else
                                    MsgBox "Le code d'activité doit être numérique!"
                                    End If
                                    End If
                                    !nbre_long_test = nbmorceau
                                    .Update
                                    End With
     
                                    With rstResultat_Echant
                                    .AddNew
                                    !noechantille = entreenoechant
                                    !NO_CONTRAT = rstContrat.Fields("noident")
                                    !boyau = rstContrat.Fields("nomboyau")
                                    !NO_PRODUIT = rstContrat.Fields("spec14")
                                    !date_livr = CDate(ENTREEDATELIVR)
                                    !diam_int = rstContrat.Fields("id")
                                    !longueur_pi = rstContrat.Fields("longueurpi")
                                    !longueur_po = rstContrat.Fields("longueurpo")
                                    'If entreecode = "" Then
                                    'Else
                                    '!ech_codeactiv = entreecode  'rstechant.Fields("codeactiv")
                                    'End If
                                    !date_livr = rstContrat.Fields("datelivr")
                                    .Update
                                   End With
     
                            'pour chaque morceau
     
                                    compteur = 1
                                    Do While Not compteur > CInt(nbmorceau)
                                    If erreur = "non" Then
                                    morceau = CStr(compteur)
                                ' trouve le premier test
                                    FIN = "non"
                                    CHCRITèRE = "trim([nospec]+[typetest]) ='" & Trim(Mid(entreeproduit, 1, 11) + strTypeTest) & "'"
                                    rsttestproduit.FindFirst CHCRITèRE
                                    If rsttestproduit.NoMatch Then
                                        MsgBox "Il n'y a pas de test de type " & strTypeTest & " pour le produit " & Mid(entreeproduit, 1, 11) & " dans la table produit_test!"
                                        erreur = "oui"
                                        FIN = "oui"
                                    Else
                                        CHCRITèRE = "cstr([numerotest])='" & CStr(rsttestproduit!notest) & "'"
                                        rstTest.FindFirst CHCRITèRE
                                        If rstTest.NoMatch Then
                                            MsgBox "Le numéro de test " & rsttestproduit!notest & " n'existe pas dans la table test!"
                                        Else
                                            strcode = rsttestproduit.Fields("CODEACTIV")
                                            CHCRITèRE = "CSTR([CODEACTIV]) = '" & CStr(strcode) & "'"
                                            rstcode.FindFirst CHCRITèRE
                                            If rstcode.NoMatch Then
                                                MsgBox "Le code d'activité " & strcode & " pour le test " & rsttestproduit.Fields("notest") & " pour le produit " & rsttestproduit.Fields("nospec") & " n'existe pas dans la table codes_test!"
                                            Else
                                            End If
                                            'If IsNull(rstechant.Fields("CODEACTIV").Value) Or rstechant!CODEACTIV >= CDec(strcode) Then
     
                                            With rstResultat_Morceau
                                                .AddNew
                                                !noechantille = entreenoechant
                                                !morceau = morceau
                                                If entreecode = "" Then
                                                Else
                                                !CODEACTIV = entreecode  'rstechant.Fields("codeactiv")
                                                End If
                                                .Update
                                                End With
     
                                           If entreecode <> "" Then
                                                If CDec(entreecode) >= CDec(strcode) Then
     
                                                    strNoSpec = Mid(entreeproduit, 1, 11)
                                                    strTypeDeTest = rstContrat.Fields("TypeTest")
                                                    strNoTest = rsttestproduit.Fields("NoTest")
                                                    nCodeActiv = rsttestproduit.Fields("CodeActiv")
                                                    strSequence = rsttestproduit.Fields("Séquence")
     
                                                    If Not IsNull(rsttestproduit.Fields("Localise")) Then
                                                        strlocalise = rsttestproduit.Fields("Localise")
                                                    Else
                                                        MsgBox "Erreur:" & Chr(13) & Chr(13) & "Composante(s) manquante(s) pour le test " & strNoTest & Chr(13) & "pour le produit " & strNoSpec & "!", vbExclamation
                                                        DoCmd.Hourglass False
                                                        Exit Function
                                                    End If
     
                                                    If Not IsNull(rsttestproduit.Fields("Qualite")) Then
                                                        strQualite = rsttestproduit.Fields("Qualite")
                                                    Else
                                                        strQualite = ""
                                                    End If
     
                                                    If Not IsNull(rsttestproduit.Fields("UnitéMesure")) Then
                                                        strMesure = rsttestproduit.Fields("UnitéMesure")
                                                    Else
                                                        strMesure = ""
                                                    End If
     
                                                    Call AjoutEchantillon.AjoutTest(strNoSpec, strNoTest, strlocalise, strQualite, nCodeActiv, entreenoechant, morceau, strSequence, bPermission, strTypeDeTest, strMesure)
                                                    bPermission = False
     
                                                End If
                                            Else
     
                                                strNoSpec = Mid(entreeproduit, 1, 11)
                                                strTypeDeTest = rstContrat.Fields("TypeTest")
                                                strNoTest = rsttestproduit.Fields("NoTest")
                                                nCodeActiv = rsttestproduit.Fields("CodeActiv")
                                                strSequence = rsttestproduit.Fields("Séquence")
     
                                                If Not IsNull(rsttestproduit.Fields("Localise")) Then
                                                    strlocalise = rsttestproduit.Fields("Localise")
                                                Else
                                                    MsgBox "Erreur:" & Chr(13) & Chr(13) & "Composante(s) manquante(s) pour le test " & strNoTest & Chr(13) & "pour le produit " & strNoSpec & "!", vbExclamation
                                                    DoCmd.Hourglass False
                                                    Exit Function
                                                End If
     
                                                If Not IsNull(rsttestproduit.Fields("Qualite")) Then
                                                    strQualite = rsttestproduit.Fields("Qualite")
                                                Else
                                                    strQualite = ""
                                                End If
     
                                                If Not IsNull(rsttestproduit.Fields("UnitéMesure")) Then
                                                    strMesure = rsttestproduit.Fields("UnitéMesure")
                                                Else
                                                    strMesure = ""
                                                End If
     
                                                Call AjoutEchantillon.AjoutTest(strNoSpec, strNoTest, strlocalise, strQualite, nCodeActiv, entreenoechant, morceau, strSequence, bPermission, strTypeDeTest, strMesure)
                                                bPermission = False
                                            End If
                                        End If
                                    End If
                                    ''''''''''''''''''
                                    ' trouve tout les test
                                    If erreur = "non" Then
                                    Do While Not FIN = "oui" 'Or erreur = "oui"
                                    CHCRITèRE = "trim([nospec]+[typetest]) ='" & Trim(Mid(entreeproduit, 1, 11) + strTypeTest) & "'"
                                    rsttestproduit.FindNext CHCRITèRE
                                    If rsttestproduit.NoMatch Then
                                        FIN = "oui"
                                        'erreur = "oui"
                                    Else
                                        CHCRITèRE = "cstr([numerotest])='" & CStr(rsttestproduit!notest) & "'"
                                        rstTest.FindFirst CHCRITèRE
                                        If rstTest.NoMatch Then
                                            MsgBox "Le numéro de test " & rsttestproduit!notest & " n'existe pas dans la table test!"
                                        Else
                                            strcode = rsttestproduit.Fields("CODEACTIV")
                                            CHCRITèRE = "CSTR([CODEACTIV]) = '" & CStr(strcode) & "'"
                                            rstcode.FindFirst CHCRITèRE
                                            If rstcode.NoMatch Then
                                                MsgBox "Le code d'activité " & strcode & " pour le test " & rsttestproduit.Fields("") & " pour le produit " & rsttestproduit.Fields("") & " n'existe pas dans la table codes_test!"
                                            Else
                                            End If
                                            If entreecode <> "" Then
                                            If CDec(entreecode) >= CDec(strcode) Then
                                            'If IsNull(rstechant.Fields("CODEACTIV").Value) Or rstechant!CODEACTIV >= CDec(strcode) Then
     
                                                strNoSpec = Mid(entreeproduit, 1, 11)
                                                strTypeDeTest = rstContrat.Fields("TypeTest")
                                                strNoTest = rsttestproduit.Fields("NoTest")
                                                nCodeActiv = rsttestproduit.Fields("CodeActiv")
                                                strSequence = rsttestproduit.Fields("Séquence")
     
                                                If Not IsNull(rsttestproduit.Fields("Localise")) Then
                                                    strlocalise = rsttestproduit.Fields("Localise")
                                                Else
                                                    MsgBox "Erreur:" & Chr(13) & Chr(13) & "Composante(s) manquante(s) pour le test " & strNoTest & Chr(13) & "pour le produit " & strNoSpec & "!", vbExclamation
                                                    DoCmd.Hourglass False
                                                     Exit Function
                                                End If
     
                                                If Not IsNull(rsttestproduit.Fields("Qualite")) Then
                                                    strQualite = rsttestproduit.Fields("Qualite")
                                                Else
                                                    strQualite = ""
                                                End If
     
                                                If Not IsNull(rsttestproduit.Fields("UnitéMesure")) Then
                                                    strMesure = rsttestproduit.Fields("UnitéMesure")
                                                Else
                                                    strMesure = ""
                                                End If
     
                                                Call AjoutEchantillon.AjoutTest(strNoSpec, strNoTest, strlocalise, strQualite, nCodeActiv, entreenoechant, morceau, strSequence, bPermission, strTypeDeTest, strMesure)
     
                                            End If
                                            Else
     
                                                strNoSpec = Mid(entreeproduit, 1, 11)
                                                strTypeDeTest = rstContrat.Fields("TypeTest")
                                                strNoTest = rsttestproduit.Fields("NoTest")
                                                nCodeActiv = rsttestproduit.Fields("CodeActiv")
                                                strSequence = rsttestproduit.Fields("Séquence")
     
                                                If Not IsNull(rsttestproduit.Fields("Localise")) Then
                                                    strlocalise = rsttestproduit.Fields("Localise")
                                                Else
                                                    MsgBox "Erreur:" & Chr(13) & Chr(13) & "Composante(s) manquante(s) pour le test " & strNoTest & Chr(13) & "pour le produit " & strNoSpec & "!", vbExclamation
                                                    DoCmd.Hourglass False
                                                     Exit Function
                                                End If
     
                                                If Not IsNull(rsttestproduit.Fields("Qualite")) Then
                                                    strQualite = rsttestproduit.Fields("Qualite")
                                                Else
                                                    strQualite = ""
                                                End If
     
                                                If Not IsNull(rsttestproduit.Fields("UnitéMesure")) Then
                                                    strMesure = rsttestproduit.Fields("UnitéMesure")
                                                Else
                                                    strMesure = ""
                                                End If
     
                                                Call AjoutEchantillon.AjoutTest(strNoSpec, strNoTest, strlocalise, strQualite, nCodeActiv, entreenoechant, morceau, strSequence, bPermission, strTypeDeTest, strMesure)
                                            End If
                                        End If
                                    End If
                                    Loop
                                    End If
                                    End If
                                    compteur = compteur + 1
                                    Loop
     
                                    If erreur = "non" Then
                                        If rstResultat_Echant.RecordCount <> 0 Then
                                            'DoCmd.ApplyFilter , "noechantille <> ''"
                                             DoCmd.ShowAllRecords
                                            Form_Résultat.Refresh
                                           ' Modifiable38.SetFocus
                                            'Modifiable38.SelText = entreenoechant
                                        End If
                                    Else
                                        CHCRITèRE = "[noechantille]='" & entreenoechant & "'"
                                        rstResultat_Echant.FindFirst CHCRITèRE
     
                                        If rstResultat_Echant.NoMatch Then
                                        Else
                                        rstResultat_Echant.Delete
                                        'DoCmd.ApplyFilter , "noechantille <> ''"
                                         DoCmd.ShowAllRecords
                                        Form_Résultat.Refresh
                                        End If
                                    End If
                                Else: MsgBox "L'entrée " & nbmorceau & " n'est pas un nombre!"
                                End If
                            End If
                        End If
                    Else
                        MsgBox "La date de livraison " & ENTREEDATELIVR & " n'est pas une date valide!"
                    End If
     
     
                Else
                'éCHANTILLON EXISTE
     
                    nbmorceau = Mcx1
                    If nbmorceau = "" Then
                        nbmorceau = "1"
                    End If
                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    'verifie s'il y a une date dans echant sinon pose question sur la date et l'ajoute
                    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    If rstEchant!DATELIVR = 0 Then
                     'If rstEchant!DATELIVR <> 0 Then     'test binh
                        DoCmd.OpenForm "AJOUTER DATE LIVRAISON", acNormal, , , , acDialog
                    End If
     
                    Form_Menu.filtrenocontrat.Value = rstEchant.Fields("NOIDENT")
                    CHCRITèRE = "trim(CSTR([NOIDENT])+cstr([spec14])+CSTR([DATELIVR])) = '" & Trim(Form_Menu.filtrenocontrat + rstEchant.Fields("nospec") + CStr(rstEchant.Fields("DATELIVR"))) & "'"
                    rstContrat.FindFirst CHCRITèRE
                    If rstContrat.NoMatch Then
                        MsgBox "Le numéro de produit " & rstEchant.Fields("nospec") & " pour le contrat " & Form_Menu.filtrenocontrat & " n'existe pas dans la table contrat pour la date de livraison " & rstEchant!DATELIVR & "!"
                        erreur = "oui"
                    Else
                        '''''''''''''''''''''''''''''
                        If IsNull(rstContrat!typetest) Then
                            strTypeTest = "603000"
                        Else
                            strTypeTest = rstContrat!typetest
                        End If
                        '''''''''''''''''''''''''''''''
                        strproduit = rstContrat.Fields("spec14")
                        CHCRITèRE = "[specgranf]='" & Mid(rstEchant.Fields("nospec"), 1, 11) & "'"
                        rstProduit.FindFirst CHCRITèRE
                        If rstProduit.NoMatch Then
                            MsgBox "Le numéro de produit " & Mid(rstEchant.Fields("nospec"), 1, 11) & " n'existe pas dans la table produit!"
                            erreur = "oui"
                        Else
                            If IsNull(rstEchant!CODEACTIV) Then
                            entreecode = code1
                            Else
                            entreecode = rstEchant!CODEACTIV
                            End If
                            If entreecode = "" Then
                                MsgBox "L'opération est annulé, aucune entrée!"
                                GoTo line1
                            Else
                                If IsNumeric(entreecode) Then
                                Else
                                    MsgBox "Le code d'activité n'est pas numérique!"
                                    GoTo line1
                                End If
                            End If
                            '''''''''''''''''''''''''''''''''''
                            With rstEchant
                            .Edit
                            '!DATELIVR = CDate(ENTREEDATELIVR)
                            '!RELACHE = -1
                            '!imp_relach = -1
                            '!RESULLABO = -1
                            '!RESULTEST = -1
                            If IsNull(entreecode) Then
                            Else
                            If IsNumeric(entreecode) Then
                                !CODEACTIV = entreecode
                            Else
                                MsgBox "Le code d'activité doit être numérique!"
                            End If
                            End If
                            !nbre_long_test = nbmorceau
                            !CODEACTIV2 = Null
                            !nbre_long_test2 = Null
     
                            !CODEACTIV3 = Null
                            !nbre_long_test3 = Null
                            .Update
                            End With
     
                            ''''''''''''''''''''''''''''''''''''
                            If IsNumeric(nbmorceau) Then
                            With rstResultat_Echant
                                .AddNew
                                !noechantille = entreenoechant
                                !NO_CONTRAT = rstContrat.Fields("noident")
                                !boyau = rstContrat.Fields("nomboyau")
                                !NO_PRODUIT = rstContrat.Fields("spec14")
                                !date_livr = CDate(rstEchant!DATELIVR)
                                !diam_int = rstContrat.Fields("id")
                                !longueur_pi = rstContrat.Fields("longueurpi")
                                !longueur_po = rstContrat.Fields("longueurpo")
     
                                .Update
                           End With
     
                        'pour chaque morceau
     
                                compteur = 1
                                Do While Not compteur > CInt(nbmorceau)
                                If erreur = "non" Then
                                morceau = CStr(compteur)
                            ' trouve le premier test
                                FIN = "non"
                                CHCRITèRE = "trim([nospec]+[typetest]) ='" & Trim(Mid(rstEchant.Fields("nospec"), 1, 11) + strTypeTest) & "'"
                                rsttestproduit.FindFirst CHCRITèRE
                                If rsttestproduit.NoMatch Then
                                    MsgBox "Il n'y a pas de test de type " & strTypeTest & " pour le produit " & Mid(rstEchant.Fields("nospec"), 1, 11) & " dans la table produit_test!"
                                    erreur = "oui"
                                    FIN = "oui"
                                Else
                                    CHCRITèRE = "cstr([numerotest])='" & CStr(rsttestproduit!notest) & "'"
                                    rstTest.FindFirst CHCRITèRE
                                    If rstTest.NoMatch Then
                                        MsgBox "Le numéro de test " & rsttestproduit!notest & " n'existe pas dans la table test!"
                                    Else
                                        strcode = rsttestproduit.Fields("CODEACTIV")
                                        CHCRITèRE = "CSTR([CODEACTIV]) = '" & CStr(strcode) & "'"
                                        rstcode.FindFirst CHCRITèRE
                                        If rstcode.NoMatch Then
                                            MsgBox "Le code d'activité " & strcode & " pour le test " & rsttestproduit.Fields("") & " pour le produit " & rsttestproduit.Fields("") & " n'existe pas dans la table codes_test!"
                                        Else
                                        End If
                                            With rstResultat_Morceau
                                            .AddNew
                                            !noechantille = entreenoechant
                                            !morceau = morceau
                                            !CODEACTIV = rstEchant.Fields("codeactiv")
                                            If IsNull(rstEchant!DATECONST) Then
                                            Else
                                                !échant_quand = rstEchant!DATECONST
                                            End If
                                            .Update
                                            End With
     
                                        If IsNull(rstEchant.Fields("CODEACTIV").Value) Or rstEchant!CODEACTIV >= CDec(strcode) Then
     
                                            strNoSpec = Mid(rstEchant.Fields("nospec"), 1, 11)
                                            strTypeDeTest = rstContrat.Fields("TypeTest")
                                            strNoTest = rsttestproduit.Fields("NoTest")
                                            nCodeActiv = rsttestproduit.Fields("CodeActiv")
                                            strSequence = rsttestproduit.Fields("Séquence")
     
                                            If Not IsNull(rsttestproduit.Fields("Localise")) Then
                                                strlocalise = rsttestproduit.Fields("Localise")
                                            Else
                                                MsgBox "Erreur:" & Chr(13) & Chr(13) & "Composante(s) manquante(s) pour le test " & strNoTest & Chr(13) & "pour le produit " & strNoSpec & "!", vbExclamation
                                                DoCmd.Hourglass False
                                                Exit Function
                                            End If
     
                                            If Not IsNull(rsttestproduit.Fields("Qualite")) Then
                                                strQualite = rsttestproduit.Fields("Qualite")
                                            Else
                                                strQualite = ""
                                            End If
     
                                            If Not IsNull(rsttestproduit.Fields("UnitéMesure")) Then
                                                strMesure = rsttestproduit.Fields("UnitéMesure")
                                            Else
                                                strMesure = ""
                                            End If
     
                                            Call AjoutEchantillon.AjoutTest(strNoSpec, strNoTest, strlocalise, strQualite, nCodeActiv, entreenoechant, morceau, strSequence, bPermission, strTypeDeTest, strMesure)
     
                                            If IsNull(code2) Or IsNull(Mcx2) Or code2 = "" Or Mcx2 = "" Then
                                            Else
                                                ajouterMorceau NOCARTE, code2, Mcx2
                                            End If
     
                                            If IsNull(code3) Or IsNull(Mcx3) Or code3 = "" Or Mcx3 = "" Then
                                            Else
                                                ajouterMorceau NOCARTE, code3, Mcx3
                                            End If
     
     
                                  ' trouve tout les test
                                        End If
                                    End If
                                End If
                                ''''''''''''''''''
                                If erreur = "non" Then
                                Do While Not FIN = "oui" 'Or erreur = "oui"
                                CHCRITèRE = "trim([nospec]+[typetest]) ='" & Trim(Mid(rstEchant.Fields("nospec"), 1, 11) + strTypeTest) & "'"
                                rsttestproduit.FindNext CHCRITèRE
                                If rsttestproduit.NoMatch Then
                                    FIN = "oui"
                                    'erreur = "oui"
                                Else
                                    CHCRITèRE = "cstr([numerotest])='" & CStr(rsttestproduit!notest) & "'"
                                    rstTest.FindFirst CHCRITèRE
                                    If rstTest.NoMatch Then
                                        MsgBox "Le numéro de test " & rsttestproduit!notest & " n'existe pas dans la table test!"
                                    Else
                                        strcode = rsttestproduit.Fields("CODEACTIV")
                                        CHCRITèRE = "CSTR([CODEACTIV]) = '" & CStr(strcode) & "'"
                                        rstcode.FindFirst CHCRITèRE
                                        If rstcode.NoMatch Then
                                            MsgBox "Le code d'activité " & strcode & " pour le test " & rsttestproduit.Fields("") & " pour le produit " & rsttestproduit.Fields("") & " n'existe pas dans la table codes_test!"
                                        Else
                                        End If
                                        If IsNull(rstEchant.Fields("CODEACTIV").Value) Or rstEchant!CODEACTIV >= CDec(strcode) Then
     
                                            strNoSpec = Mid(rstEchant.Fields("nospec"), 1, 11)
                                            strTypeDeTest = rstContrat.Fields("TypeTest")
                                            strNoTest = rsttestproduit.Fields("NoTest")
                                            nCodeActiv = rsttestproduit.Fields("CodeActiv")
                                            strSequence = rsttestproduit.Fields("Séquence")
     
                                            If Not IsNull(rsttestproduit.Fields("Localise")) Then
                                                strlocalise = rsttestproduit.Fields("Localise")
                                            Else
                                                MsgBox "Erreur:" & Chr(13) & Chr(13) & "Composante(s) manquante(s) pour le test " & strNoTest & Chr(13) & "pour le produit " & strNoSpec & "!", vbExclamation
                                                DoCmd.Hourglass False
                                                Exit Function
                                            End If
     
                                            If Not IsNull(rsttestproduit.Fields("Qualite")) Then
                                                strQualite = rsttestproduit.Fields("Qualite")
                                            Else
                                                strQualite = ""
                                            End If
     
                                            If Not IsNull(rsttestproduit.Fields("UnitéMesure")) Then
                                                strMesure = rsttestproduit.Fields("UnitéMesure")
                                            Else
                                                strMesure = ""
                                            End If
     
                                            Call AjoutEchantillon.AjoutTest(strNoSpec, strNoTest, strlocalise, strQualite, nCodeActiv, entreenoechant, morceau, strSequence, bPermission, strTypeDeTest, strMesure)
                                        End If
                                    End If
                                End If
                                Loop
                                End If
                                End If
                                compteur = compteur + 1
                                Loop
     
                                If erreur = "non" Then
                                    If rstResultat_Echant.RecordCount <> 0 Then
                                        'DoCmd.ApplyFilter , "noechantille <> ''"
                                         'DoCmd.ShowAllRecords
                                        'Form_Résultat.Refresh
                                       ' Modifiable38.SetFocus
                                        'Modifiable38.SelText = entreenoechant
                                    End If
                                Else
                                    CHCRITèRE = "[noechantille]='" & entreenoechant & "'"
                                    rstResultat_Echant.FindFirst CHCRITèRE
     
                                    If rstResultat_Echant.NoMatch Then
                                    Else
                                    rstResultat_Echant.Delete
                                    'DoCmd.ApplyFilter , "noechantille <> ''"
                                     DoCmd.ShowAllRecords
                                    Form_Résultat.Refresh
                                    End If
                                End If
                            Else: MsgBox "L'entrée " & nbmorceau & " n'est pas un nombre!"
                            End If
                        End If
                    End If
                End If
            Else
                supprimerEchantillon NOCARTE
                GoTo debut
            End If
        Else
            erreur = "oui"
        End If
    'supprime morceau et echant si pas de test
    If erreur = "non" Then
    CHCRITèRE = "[noechantille]= '" & entreenoechant & "'"
    RSTRESULTAT_TEST.FindFirst CHCRITèRE
    If RSTRESULTAT_TEST.NoMatch Then
        FIN = "non"
        Do While Not FIN = "oui"
        rstResultat_Morceau.FindFirst CHCRITèRE
        If rstResultat_Morceau.NoMatch Then
        FIN = "oui"
        Else
        rstResultat_Morceau.Delete
        End If
        Loop
        FIN = "non"
        Do While Not FIN = "oui"
        rstResultat_Echant.FindFirst CHCRITèRE
        If rstResultat_Echant.NoMatch Then
        FIN = "oui"
        Else
        rstResultat_Echant.Delete
        End If
        Loop
        MsgBox "Il n'y a aucun test correspondant, vérifié le code de fréquence de test ou le type de test!"
    End If
    End If
     
    DoCmd.Hourglass False
     
    line1:
    rsttestproduit.Close
    rstTest.Close
    rstContrat.Close
    rstEchant.Close
    rstcode.Close
    rstProduit.Close
    rstResultat_Echant.Close
    rstResultat_Morceau.Close
    RSTRESULTAT_TEST.Close
    Set bds = Nothing
     
    End Function
    Voici le code dans le module AjouteEchantillon : la fonction AjouteTest
    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
     
    Sub AjoutTest(strNoSpec As String, strNoTest As String, strlocalise As String, strQualite As String, nCodeActiv As String, strNoEchant, nMorceau, strSequence As String, bPermission As Boolean, strTypeTest As String, strMesure As String)
     
    'Ajoute les tests pour chaque échantillon et pour chaque morceau dans la
    'table gf_resultat_test et vérifie pour pas qu'il y est de doublons dans les tests.
     
    Static bds As Database
    Static rstResultatTest As Recordset, rstProduitTest As Recordset
    Dim strCritere As String
     
    If bPermission = True Then
    Set bds = CurrentDb
    Set rstResultatTest = bds.OpenRecordset("Select * from gf_resultat_test where NoEchantille='" & strNoEchant & "'", dbOpenDynaset)
    Set rstProduitTest = bds.OpenRecordset("Select * from gf_prodtest where NoSpec='" & strNoSpec & "'", dbOpenDynaset)
    End If
     
    'Cherche le premier test pour ce morceau de l'échantillon.
     
    If strQualite <> "" Then
        If strMesure <> "" Then
            strCritere = "[NoSpec]='" & strNoSpec & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localise]='" & strlocalise & "' AND [Qualite]='" & strQualite & "' AND CStr([Séquence])='" & strSequence & "' AND TypeTest='" & strTypeTest & "' AND UnitéMesure='" & strMesure & "'"
        Else
            strCritere = "[NoSpec]='" & strNoSpec & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localise]='" & strlocalise & "' AND [Qualite]='" & strQualite & "' AND CStr([Séquence])='" & strSequence & "' AND TypeTest='" & strTypeTest & "' AND UnitéMesure = NULL"
        End If
    Else
        If strMesure <> "" Then
            strCritere = "[NoSpec]='" & strNoSpec & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localise]='" & strlocalise & "' AND [Qualite]= NULL AND CStr([Séquence])='" & strSequence & "'AND TypeTest='" & strTypeTest & "' AND UnitéMesure='" & strMesure & "'"
        Else
            strCritere = "[NoSpec]='" & strNoSpec & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localise]='" & strlocalise & "' AND [Qualite]= NULL AND CStr([Séquence])='" & strSequence & "'AND TypeTest='" & strTypeTest & "' AND UnitéMesure = NULL"
        End If
    End If
     
    rstProduitTest.FindFirst strCritere
     
    'Vérifie si le test existe déjà dans la table gf_resultat_test
     
    If strQualite <> "" Then
        If strMesure <> "" Then
            strCritere = "[NoEchantille]='" & strNoEchant & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localisation]='" & strlocalise & "' AND [Qualite]='" & strQualite & "' AND CStr([Morceau])='" & CStr(nMorceau) & "' AND Mesure='" & strMesure & "'"
        Else
            strCritere = "[NoEchantille]='" & strNoEchant & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localisation]='" & strlocalise & "' AND [Qualite]='" & strQualite & "' AND CStr([Morceau])='" & CStr(nMorceau) & "'  AND Mesure = NULL"
        End If
    Else
        If strMesure <> "" Then
            strCritere = "[NoEchantille]='" & strNoEchant & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localisation]='" & strlocalise & "' AND [Qualite]= NULL AND CStr([Morceau])='" & CStr(nMorceau) & "' AND Mesure='" & strMesure & "'"
        Else
            strCritere = "[NoEchantille]='" & strNoEchant & "' AND CStr([NoTest])='" & strNoTest & "' AND [Localisation]='" & strlocalise & "' AND [Qualite]= NULL AND CStr([Morceau])='" & CStr(nMorceau) & "'  AND Mesure = NULL"
        End If
    End If
     
    rstResultatTest.FindFirst strCritere
     
    'S'il n'existe pas on l'ajoute, sinon on vérifie si le code d'activitée est plus grand ou
    'égal au code d'activité existant pour ce test, si oui on change la séquence existante pour
    'la séquence du test ayant le code d'activité le plus grand.
     
    If rstResultatTest.NoMatch = True Then
        With rstResultatTest
            .AddNew
            !noechantille = strNoEchant
            !notest = rstProduitTest.Fields("notest")
            !Localisation = rstProduitTest.Fields("localise")
            !qualite = rstProduitTest.Fields("qualite")
            !minimum = rstProduitTest.Fields("min")
            !maximum = rstProduitTest.Fields("max")
            !nominal = rstProduitTest.Fields("nominal")
            !mesure = rstProduitTest.Fields("unitémesure")
            !morceau = nMorceau
            !séquence = rstProduitTest.Fields("séquence")
            .Update
        End With
    Else
        If nCodeActiv >= rstProduitTest.Fields("CodeActiv") Then
            rstResultatTest.Edit
            rstResultatTest.Fields("Séquence") = strSequence
            rstResultatTest.Update
        End If
    End If
     
    'rstResultatTest.Close
    'rstProduitTest.Close
    'Set bds = Nothing
     
    End Sub



    Alors, si vous voulez m'aider a étudier ce code vous êtes les bienvenus.
    Charles Bergeron - Webmaster/Infographe/Photographe

  2. #2
    Membre habitué
    Profil pro
    Inscrit en
    Mars 2006
    Messages
    166
    Détails du profil
    Informations personnelles :
    Âge : 46
    Localisation : Canada

    Informations forums :
    Inscription : Mars 2006
    Messages : 166
    Points : 169
    Points
    169
    Par défaut Re: Problèmes avec création d'une série de test dans une tab
    Citation Envoyé par charleshbo
    Le problème est que dans les opérations (que je trace sans arrêts depuis 3 jours pour trouver quoi faire) duplique certains enregistrement et en oublie certains...
    Le problème d'oublie de certains enregistrement et de duplication me fait penser à un bug au niveau des relations entre table et/ou dans la requête SQL. Je crois que c'est la 1ère place à investiguer: oublie le code qui sort l'info et vérifie directement en créant des requêtes par le générateur de requêtes SQL.

    Tu pourrais par exemple mettre un
    Debug.Print "select * from gf_echant where noident = '" & lstNoIdent.Value & "' and nospec = '" & Liste10.Column(0) & "' and ( cstr(datelivr) = '" & CStr(Liste10.Column(1)) & "' or cstr(datelivr) = '12:00:00 AM' or cstr(datelivr) ='00:00:00' ) and gf_echant.nocarte in (select nocarte from req_echant) "
    'and gf_echant.nocarte in (select nocarte from req_echant"

    Ensuite, copie la chaîne qui va sortir de la fenêtre Exécution. Colle dans l'éditeur de requête et vérifier directement les données. C'est plus facile à partir de là d'essayer de comprendre pourquoi la requête n'envoie pas les enregistrements attendus.

    Bonne chance.
    Caroline
    N'oubliez pas le tag . En haut: Outils de la discussion -> Résolu.

  3. #3
    Provisoirement toléré Avatar de charleshbo
    Profil pro
    Inscrit en
    Janvier 2006
    Messages
    222
    Détails du profil
    Informations personnelles :
    Âge : 38
    Localisation : France

    Informations forums :
    Inscription : Janvier 2006
    Messages : 222
    Points : 125
    Points
    125
    Par défaut
    @Caroline1 : Non, ce n'est pas un problème de requêtes, j'ai déjà vérifié.

    Je viens de trouver un peu plus ou se situerait le problème. Dans le module "AjouteEchantillon", lorsqu'il recherche dans la table gf_prodtest, il me sort toujours le même enregistrement.

    Ce peut-il, que vu que la requête pour le RecordSet est avec Where NoSpec = ..., que dans ma chaine de critères, lorsqu'il recherche justement ce NoSpec cela pourrait occassionner des erreurs?
    Charles Bergeron - Webmaster/Infographe/Photographe

  4. #4
    Membre habitué
    Profil pro
    Inscrit en
    Mars 2006
    Messages
    166
    Détails du profil
    Informations personnelles :
    Âge : 46
    Localisation : Canada

    Informations forums :
    Inscription : Mars 2006
    Messages : 166
    Points : 169
    Points
    169
    Par défaut
    Ben... oui! Si la requête SQL n'a pas les bons critères, le recordset ne contiendra forcément pas les enregistrements attendus, d'où doublon et données manquantes.

    Ce que tu dis me semble justement être un problème de requête ;-). Je comprends que tu as vérifié que la structure de la table était ok : reste donc à valider les clauses WHERE, dont ce NoSpec.

    Je bosse aussi : pas le temps d'étudier ton lonnnnnnnnng "bout de code". Surtout qu'il est impossible à tester sans tout le puzzle.

    Caroline
    N'oubliez pas le tag . En haut: Outils de la discussion -> Résolu.

  5. #5
    Provisoirement toléré Avatar de charleshbo
    Profil pro
    Inscrit en
    Janvier 2006
    Messages
    222
    Détails du profil
    Informations personnelles :
    Âge : 38
    Localisation : France

    Informations forums :
    Inscription : Janvier 2006
    Messages : 222
    Points : 125
    Points
    125
    Par défaut
    C'est sur, c'est sur. Merci beaucoup de ton aide. Il s'agit d'un problème de requête, mais dans le code.

    Devrais-je utiliser un 'FindFirst' ou un 'FindNext'? pour la recherche du critère?
    Charles Bergeron - Webmaster/Infographe/Photographe

  6. #6
    Provisoirement toléré Avatar de charleshbo
    Profil pro
    Inscrit en
    Janvier 2006
    Messages
    222
    Détails du profil
    Informations personnelles :
    Âge : 38
    Localisation : France

    Informations forums :
    Inscription : Janvier 2006
    Messages : 222
    Points : 125
    Points
    125
    Par défaut
    C'est quand même assez difficile de débugger tout ça... car c'est un autre stagiaire qui a monté ce programme je ne sais pas trop quand... Avoir été le concepteur, il n'y aurait pas eu de bugs comme celui-ci...
    Charles Bergeron - Webmaster/Infographe/Photographe

  7. #7
    Membre habitué
    Profil pro
    Inscrit en
    Mars 2006
    Messages
    166
    Détails du profil
    Informations personnelles :
    Âge : 46
    Localisation : Canada

    Informations forums :
    Inscription : Mars 2006
    Messages : 166
    Points : 169
    Points
    169
    Par défaut
    Citation Envoyé par charleshbo
    Avoir été le concepteur, il n'y aurait pas eu de bugs comme celui-ci...
    Facile à dire ;-).

    Le meilleur truc, c'est d'utiliser les outils de déboggage de manière intensive. Fenêtre exécution, fenêtre espion, Debug.Print.

    Je ne sais pas ce qui est mieux entre FindFirst ou FindNext. Je ne passerais pas par là. Je copierais la requête SQL (obtenu par Debug.Print) dans une nouvelle requête (en mode SQL) et je regarderais l'ensemble des enregistrements par une vue "Mode feuille de données". À comparer avec les résultats attendus.

    Désolée si je me répète ;-).
    Caroline
    N'oubliez pas le tag . En haut: Outils de la discussion -> Résolu.

  8. #8
    Provisoirement toléré Avatar de charleshbo
    Profil pro
    Inscrit en
    Janvier 2006
    Messages
    222
    Détails du profil
    Informations personnelles :
    Âge : 38
    Localisation : France

    Informations forums :
    Inscription : Janvier 2006
    Messages : 222
    Points : 125
    Points
    125
    Par défaut
    J'ai modifié un peu la requête en question mais la j'ai un autre problème.

    Voici la requete :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Select * from gf_prodtest where NoSpec='" & strNoSpec & "' And CODEACTIV <='" & CInt(nCodeActiv) & "'"
    Sa me donne une erreur dans le genre : Erreur 3463 "Types de données incompatibles dans l'expression du critère."




    P.S.: Je viens de remarquer que t'es une québécoise!
    Charles Bergeron - Webmaster/Infographe/Photographe

  9. #9
    Expert éminent
    Avatar de cafeine
    Inscrit en
    Juin 2002
    Messages
    3 904
    Détails du profil
    Informations forums :
    Inscription : Juin 2002
    Messages : 3 904
    Points : 6 781
    Points
    6 781
    Par défaut
    oui, c'est une erreur du code répertoriée dans les FAQ :

    http://cafeine.developpez.com/access...ugprint/#LVI-C

    la conversion CInt() indique que ton second champ est numérique ...
    Ne mettez pas "Problème" dans vos titres, par définition derrière toute question se cache un problème
    12 tutoriels Access



  10. #10
    Provisoirement toléré Avatar de charleshbo
    Profil pro
    Inscrit en
    Janvier 2006
    Messages
    222
    Détails du profil
    Informations personnelles :
    Âge : 38
    Localisation : France

    Informations forums :
    Inscription : Janvier 2006
    Messages : 222
    Points : 125
    Points
    125
    Par défaut
    c'est moi qui a ajouté la fonction CInt()

    Mais je sais c'est quoi l'erreur, il ne faut pas d'apostrophes pour un numérique.... (je l'ai su grace a ton aide...)
    Charles Bergeron - Webmaster/Infographe/Photographe

Discussions similaires

  1. Réponses: 2
    Dernier message: 11/06/2015, 20h12
  2. Réponses: 3
    Dernier message: 23/01/2012, 14h50
  3. [GD] Problème avec des fonctions qui créent des éléments dans une image.
    Par magnus2229 dans le forum Bibliothèques et frameworks
    Réponses: 2
    Dernier message: 13/07/2011, 09h38
  4. Réponses: 2
    Dernier message: 20/04/2011, 15h26
  5. Réponses: 1
    Dernier message: 26/12/2010, 21h20

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo