Gestion des erreurs en VBA déclanchée par un "Update"

**Eltom_octo** · 31/01/2017, 19h07

Bonjour à tous,

Je suis un peu perdu et je sollicite votre aide.

Voici mon projet et mon problème. Je suis à créer un base de données Access (Access 2013). Je fais toute mes opérations en VBA. Le projet contien un assez grand nombre de table et de formulaire mais pour les besoin de l'explication je vais simplement parler d'un formulaire en particulier.

J'ai une table T_Compagnie qui contiens les champ suivant :

- ID_Compagnie (NuméroAuto)
-Nom (Nom de la compagnie en texte court)
-PNAME (nom de la compagnie en majuscule sans accent, texte court) - Indexé sans doublons
-No_Cie (Numéro administratif de la compagnie, Texte court)

J'utilise le code suivant pour ajouter la nouvelles compagnie dans la table :

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
 
Private Sub But_Save_Click()
On Error GoTo Pop_Erreur
 
 
 
'###################################################################################################################
'Fonction qui ajoute une compagnie et son numéro d'identification administratif à la table T_Compagnie
'###################################################################################################################
 
'---------------------------------------------------------------------------------------------------------------
'Cette fonction ne fonctionne que dans le contexte d'utilisation du formulaire [F_Main].[SF_Main_Nav] et ne fonctionnera
'pas lors de l'utilisation du formulaire SF_Ajout_compagnie seul
'---------------------------------------------------------------------------------------------------------------
 
Set d = CurrentDb.OpenRecordset("T_Compagnie", DB_OPEN_DYNASET)
 
cdcd = PO_NAME([Forms]![F_Main]![SF_Main_Nav]![SF_Add_Nav]![Txt_Cie])
 
    '---------------------------------------------------------------------------------------------------------------
    'Ajouter le nouveau nom de responsable à la table T_Responsable
    '---------------------------------------------------------------------------------------------------------------
    d.AddNew
    d("PNAME") = cdcd
    d("Nom") = [Forms]![F_Main]![SF_Main_Nav]![SF_Add_Nav]![Txt_Cie]
    d("No_Cie") = [Forms]![F_Main]![SF_Main_Nav]![SF_Add_Nav]![Txt_No_Cie]
    d.Update
    d.MoveLast
    d.Close
    MsgBox "Le nouvelle compagnie a été correctement ajouté"
 
    '-------------------------------------------------------------------------------------------------------------------
    ' Remise à zéro du formulaire
    '-------------------------------------------------------------------------------------------------------------------
        Dim CTRL As Control
 
        For Each CTRL In Me.Controls
            If TypeOf CTRL Is TextBox Then
                CTRL = Null
            ElseIf TypeOf CTRL Is ComboBox Then
                CTRL = Null
            ElseIf TypeOf CTRL Is CheckBox Then
                CTRL = False
            End If
        Next
        Me.Refresh
 
 
 
 
 
    '---------------------------------------------------------------------------------------------------------------
    'Gestion de l'erreur 3022, risque de doublon dans le champ PNAME
    '---------------------------------------------------------------------------------------------------------------
 
Pop_Erreur:
 
        '
        'Gestion des erreurs de saisie
        '
        Response = acDataErrContinue
        DataErrorManager Me, Err.Number
 
 
End Sub

J'ai un module de gestion d'erreur que j'ai récupéré sur ce forum (Merci à FRED.G).

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
 
'--------------------------------------------------------------------------------------------------------------------------------------------
'Code copier du forum Developpez.com, merci à FRED.G
'--------------------------------------------------------------------------------------------------------------------------------------------
 
Function FormattedMsgBox(Prompt As String, _
                        Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
                        Optional Title As String = vbNullString, _
                        Optional HelpFile As Variant, _
                        Optional Context As Variant) As VbMsgBoxResult
On Error GoTo GestionErr
  If IsMissing(HelpFile) Or IsMissing(Context) Then
    FormattedMsgBox = Eval("MsgBox(""" & Prompt & """, " & Buttons & ", """ & Title & """)")
  Else
    FormattedMsgBox = Eval("MsgBox(""" & Prompt & """, " & Buttons & ", """ & Title & """, """ & _
                            HelpFile & """, " & Context & ")")
  End If
Exit Function
' Bloc de gestion d'erreurs ajouté par le complément Commentaire de code et Gestionnaire d'erreurs VBA. NE MODIFIEZ PAS ce bloc de code.
GestionErr:
  Select Case Err.Number
    Case Else
       MsgBox "Erreur " & Err.Number & " : " & Err.Description, vbCritical, "mdu.FormattedMsgBox"
  End Select
' Fin du bloc de gestion d'erreurs.
End Function
 
Public Sub DataErrorManager(ByRef f As Form, errorNumber As Integer)
 
    Select Case errorNumber
      Case 2107, 2116 'Non respect des règles de validation
        FormattedMsgBox "Données non valides.@" & _
        GetValidationText(f, f.ActiveControl) & "@" & _
        "Vous pouvez appuyez sur ÉCHAP pour annuler vos modifications.@", vbCritical, "Inventaire 2.0"
        'f.ActiveControl.Undo
      Case 2113, 2279   'saisie / format incorrect
        FormattedMsgBox "Données non valides.@" & _
        GetValidationText(f, f.ActiveControl) & "@" & _
        "Vous pouvez appuyez sur ÉCHAP pour annuler vos modifications.@", vbCritical, "Inventaire 2.0"
        'f.ActiveControl.Undo
      Case 3101, 3314 'intégrité réf / champ null
        '
      Case 3022 'Doublons interdit
        FormattedMsgBox "Possibilité de doublon.@" & _
        GetValidationText(f, f.ActiveControl) & "@" & _
        "Vérifiez les informations saisies puis recommencer.@", vbCritical, "Inventaire 2.0"
      Case 2237 'Absence dans liste
        FormattedMsgBox "Le texte entré n'est pas un élément de la liste.@" & _
        "Sélectionnez un élément de la liste ou entrez un texte qui correspond à un des éléments de la liste ou appuyez sur ÉCHAP pour annuler vos modifications.@", vbCritical, "Inventaire 2.0"
        f.ActiveControl.Dropdown
      Case 3162 'Absence dans liste mais saisie nulle
        FormattedMsgBox "Vous n'avez saisi aucune valeur.@" & _
        "Sélectionnez un élément de la liste ou entrez un texte qui correspond à un des éléments de la liste ou appuyez sur ÉCHAP pour annuler vos modifications.@", vbCritical, "Inventaire 2.0"
        f.ActiveControl.Dropdown
      Case 2169 'Demande de fermeture malgré des données non validées et donc non enregistrées.
        'Ne dois apparaitre si 3101, 3314 ou 3022 ont exécuté un f.Undo
        '
      Case 7753
        FormattedMsgBox "Données non valides.@" & _
        GetValidationText(f, f.ActiveControl) & "@" & _
        "Vous pouvez appuyez sur ÉCHAP pour annuler vos modifications.@", vbCritical, "Inventaire_2"
        'f.ActiveControl.Undo
      Case Else
        MsgBox "L'erreur " & errorNumber & " c'est produite" & ". " & vbCrLf & Application.AccessError(errorNumber), vbCritical
    End Select
End Sub
 
Private Function GetValidationText(ByRef f As Form, ByRef ctl As Control) As String
 
    On Error Resume Next
    If ctl Is Nothing Then Exit Function
    If Len(ctl.ValidationText) > 0 Then
        GetValidationText = ctl.ValidationText
    Else
        GetValidationText = f.Recordset.Fields(ctl.ControlSource).ValidationText
    End If
End Function
 
''Mettre se code dans le formulaire
'Private Sub Form_Error(DataErr As Integer, Response As Integer)
'    '
'    'Gestion des erreurs de saisie
'    '
'    Response = acDataErrContinue
'    DataErrorManager Me, DataErr
'End Sub

Le code fonctionne mais je voudrais que dans le MsgBox le nom du champ qui cause l'erreur soit spécifier automatiquement afin d'ajouter en clarté au message d'erreur et ainsi pouvoir appliquer le module à toute ma base de donnée.

Je débute en VBA mais je commence tranquillement à me faire la main. Je ne suis pas programmeur de métier donc j'avance lentement mais sureent dans le merveilleux monde du VBA

Je solicite votre aide afin de m'aider à identifier la manière d’obtenir le résultat voulue. J'attire votre attention sur l'erreur 3022 car c'est sur cette erreur que je tente de parfaire mon code. Une fois que j'aurai saisi la bonne méthote à utiliser je pourrai l'appliquer à plus grande échelle et aussi le réutiliser dans tout mes autre projet nécésitant la gestion des erruers en VBA.

Il me fera plaisir de poster le résultat final question d'aider d'autre débutant comme moi par la suite.

Bref je vous remercie d'avance pour le temps consacré à analyser mon petit défi.

PS: je vois bien qu'il y a cette ligne de code qui semble récupérer le nom du contrôle qui a causé l'erreur mais dans mon cas c'est un "Update" dans du code VBA qui cause l'erreur

Code :

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

1
2
 
GetValidationText(f, f.ActiveControl) & "@" & _

**Jean-Philippe André** · 01/02/2017, 11h27

Salut,

le detail complet de l'erreur est disponible via

Code :

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

Err.Description

L'info de doublon n'indique pas dans le detail ce qui pose probleme.

Si tu as besoin de savoir quels sont les champs qui doivent etre sans doublon, reste la possibilite de parcourir tous les champs de ta table en VBA et d'extirper l'information sans doublon avec la propriete Unique des index.
https://msdn.microsoft.com/fr-fr/lib.../ff821087.aspx

Sur la recherche de donnees en amont de l'insertion (donc avant de generer l'erreur)
https://www.developpez.net/forums/d7...ns-formulaire/

**Eltom_octo** · 01/02/2017, 15h00

Merci beaucoup pour la réponse,

J'explore tout ¸ça aujourd'hui et je vous reviens avec le résultat.

Bonne journée

Gestion des erreurs en VBA déclanchée par un "Update"

VBA Access

Vue hybride

Discussions similaires

Partager

Partager