Discussion :

[herendel]

salut,
voilà j'ai ecris ce code pour pouvoir créer X enregistrement identique mais le bouton annuler de la input box me donne le message 'vous devez entrer un entier' (chose qu'il doit faire si on ne rentre pas un entier)
comment faire eviter ce problème, tout en gardant ce message d'erreur si on ne rentre pas un entier mais avec un bouton annuler qui marche
merci

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
 
Function CopierDonneesresultat()
On Error GoTo Err_CopierDonneesresultat
Dim Db As Database
Dim intNombreFiche, intNombreFichesACreer As Integer
Dim strReponseQuestion, strSQLInsertion, strSQLSuppression As String
 
'Enregistre la fiche en cours
If CurrentProject.AllForms("F_serothequeFS").IsLoaded Then
   Forms![F_serothequeFS].SetFocus
   DoCmd.RunCommand acCmdSaveRecord
End If
Set Db = CurrentDb()
'Suppression de tous les enregistrements dans la table C_resultats_sanitaire
strSQLSuppression = "Delete * from [C_resultats_sanitaire]"
Db.Execute strSQLSuppression
 
'Demande sur combien de nouvelles fiches il faut réaliser la copie
strReponseQuestion = InputBox("Combien de nouvelles fiches désirez vous créer ?", "Nombre de copie à réaliser", intNombreFichesACreer)
 
        If strReponseQuestion = 0 Then
 
            'nombre de fiches crées là se sera zero
            MsgBox "Nombre de fiches créées:" & CInt(strReponseQuestion) & "", vbOKOnly, "Nombre de fiches"
 
            Else
 
            If IsNumeric(strReponseQuestion) Then
            intNombreFiche = CInt(strReponseQuestion)
 
        'Affiche le sablier
        DoCmd.Hourglass True
 
            'boucle qui copie les données
            Do Until intNombreFiche = 0
 
                'Insertion des données
                strSQLInsertion = "INSERT INTO [C_resultats_sanitaire] ([Clef_m/m], [Date_resultat], [Clef_Labo/contact], "
                strSQLInsertion = strSQLInsertion & " [Proprietaire_resultat], [Resultat_brut], [Resultat_interprete], [Commentaire]) "
                strSQLInsertion = strSQLInsertion & " SELECT '" & Forms![F_resultat]![Clef_m/m] & "','" & Forms![F_resultat]![Date_resultat] & "','"
                strSQLInsertion = strSQLInsertion & Forms![F_resultat]![Clef_labo/contact] & "','" & Forms![F_resultat]![Proprietaire_resultat] & "','"
                strSQLInsertion = strSQLInsertion & Forms![F_resultat]![Resultat_brut] & "','" & Forms![F_resultat]![Resultat_interprete] & "','"
                strSQLInsertion = strSQLInsertion & Forms![F_resultat]![Commentaire] & "'"
                Db.Execute strSQLInsertion
                intNombreFiche = intNombreFiche - 1
            Loop
 
            'Supprime le sablier
            DoCmd.Hourglass False
 
            'nombre de fiches crées
            MsgBox "Nombre de fiches créées:" & CInt(strReponseQuestion) & "", vbOKOnly, "Nombre de fiches"
 
            Dim stDocName As String
            'fermeture du formulaire
            DoCmd.close , stDocName, acSavePrompt
            'ouvre le formualire F_ref_boite
             Dim stLinkCriteria As String
             stDocName = "F_resultats_cc"
             DoCmd.OpenForm stDocName, , , stLinkCriteria
             Else
             MsgBox "Vous devez saisir un entier.", 16
             CopierDonneesresultat
 
        End If
End If
'Fermeture des éléments de base
Db.close
Set Db = Nothing
strSQLSuppression = ""
strSQLInsertion = ""
 
Exit_CopierDonneesresultat:
    Exit Function
Err_CopierDonneesresultat:
'Supprime le sablier
    DoCmd.Hourglass False
    MsgBox Error$
    Resume Exit_CopierDonneesresultat
End Function

[Arkham46]

slt,

d'abord je te conseille d'indenter ton code (Smart Indenter fait ça tout seul et très bien), c'est difficilement lisible dans cet état

sinon pour tester les différents cas :

Code :

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

1
2
3
4
5
6
7
8
9
10
 
If StrPtr(strReponseQuestion) = 0 then
' On a cliqué sur annuler  
ElseIf strReponseQuestion = "" then
' On a rien saisi et cliqué sur OK
ElseIf IsNumeric(strReponseQuestion ) then
' On a saisi du numérique et cliqué sur OK
Else
' On a saisi du texte alphanumérique et cliqué sur OK
Endif

[herendel]

merci pour la réponse

If StrPtr(strReponseQuestion) = 0 then
' On a cliqué sur annuler

j'avais juste a rajouter sa

désolé pour l'indentification mais je peux pas installer Smart Indenter car je suis pas administrateur réseau et il est pas là en se moment...