Saisie dans Sous Formulaire feuille données

**Jupaysan** · 26/05/2020, 11h23

Bonjour,

J'ai un petit problème avec la saisie dans mes sous forms, peut être que la solution est évidente pour les personnes expérimentées.
J'ai un formulaire Principal "Frm_Projet" contenant un Sfrm "Frm_Administratif" et les 2 sont liés par le champ père/fils.
Le Sfrm contient entre autre les champs suivants:
- Adm_Id: numéro automatique
- "Client_Id" dont le contenu est une liste déroulante basée sur une requête permettant d'afficher le Nom - Prénom du Client. Tout fonctionne nickel.

Cependant, lorsque l'utilisateur choisit un client et décide de l'éffacer (touche "retour" du clavier), le champ s’efface mais le champ Admin_Id garde son numéro et si perte de focus, j'ai le message suivant

Vous devez entrer une valeur dans le champ..

Il faut appuyer une ou plusieurs fois sur la touche "Echap" du clavier pour annuler l'enregistrement.

Ma question est: Comment faire pour annuler automatiquement l'enregistrement (vider le champ Admin_Id) sans avoir à utiliser la touche "Echap"

J'ai essayé les codes suivants sans succès

Code langage :

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

1
2
3
4
5
6
7
8
Private Sub Form_BeforeUpdate(Cancel As Integer)
'Vérifie que les champs obligatoires ne sont pas vides avant sauvegarde '
If IsNull(Me.Client_Id) Or Me.Client_Id = "" Or Me.Client_Id = " " Then
    DoCmd.RunCommand acCmdUndo
    MsgBox "Saisie a été annulée car au moins un champ obligatoire était vide.", vbExclamation, "***Annulation***"
    Exit Sub
End If
End Sub

Code langage :

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

1
2
3
4
Private Sub Form_Error(DataErr As Integer, Response As Integer)
MsgBox " Client (Nom - Prénom) est obligatoire" & vbCrLf & vbCrLf & "Enregistrement supprimé", vbCritical, "***Attention***"
   DoCmd.RunCommand acCmdDeleteRecord
End Sub

A noter que, j'utilise beaucoup les Sfrm en mode feuilles données, je ne sais pas si c'est une erreur. je n'ai pas assez de recul. Un avis au passage serait toujours la bienvenue.

Merci pour votre précieuse aide.

**EricDgn** · 28/05/2020, 17h48

Bonjour,

Voir si ceci pourrait convenir:

Code :

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

1
2
3
4
5
6
7
8
Private Sub Form_BeforeUpdate(Cancel As Integer)
    'Vérifie que les champs obligatoires ne sont pas vides avant sauvegarde '
    If Replace(Nz(Me.Client_Id, ""), " ", "") = "" Then
        MsgBox "Saisie annulée car au moins un champ obligatoire était vide.", vbExclamation, "***Annulation***"
        Form.Undo
        Exit Sub
    End If
End Sub

Bonne continuation.

**morobaboumar** · 15/06/2020, 01h19

Bonjour EricDgn,
Comment pourrais je adapter votre code à ma recherche qui consiste à restaurer des données d'origine;
c'est à dire annuler (undo) ou répéter(Redo) les enregistrements en cours ?

NB: Je vous signale que ce code m’intéresse énormément.
Je pris les membres de la rédaction de ne pas supprimer mon présent post.
Merci d'avance.

Cordialement.

**morobaboumar** · 02/06/2021, 03h51

Envoyé par EricDgn

Bonjour,

Voir si ceci pourrait convenir:

Code :

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

1
2
3
4
5
6
7
8
Private Sub Form_BeforeUpdate(Cancel As Integer)
    'Vérifie que les champs obligatoires ne sont pas vides avant sauvegarde '
    If Replace(Nz(Me.Client_Id, ""), " ", "") = "" Then
        MsgBox "Saisie annulée car au moins un champ obligatoire était vide.", vbExclamation, "***Annulation***"
        Form.Undo
        Exit Sub
    End If
End Sub

Bonne continuation.

Bonjour EricDgn ,

Code :

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

1
2
3
4
5
6
7
8
Private Sub Form_BeforeUpdate(Cancel As Integer)
    'Vérifie que les champs obligatoires ne sont pas vides avant sauvegarde '
    If Replace(Nz(Me.Categorie, ""), " ", "") = "" Then
        MsgBox "Saisie annulée car au moins un champ obligatoire était vide.", vbExclamation, "***Annulation***"
        Form.Undo
        Exit Sub
    End If
End Sub

Je viens de tester votre code. Il me supprime les données de la première zone de texte des que le curseur
quitte celle ci pour une autre zone de texte de la même ligne or mon souhait est que le code signale
le vide de la zone de texte obligatoire.

Nom : CaptureErreurChampObligatoireVide.PNG
Affichages : 78
Taille : 45,8 Ko

Nom : CaptureErreurChampObligatoireVide.PNG
Affichages : 78
Taille : 45,8 Ko

Nom : CaptureErreurChampObligatoireVide 2.PNG
Affichages : 75
Taille : 4,2 Ko

Merci encore une de bien vouloir m'aider.
Cordialement.

**EricDgn** · 02/06/2021, 16h30

Bonjour,

Voir si quelque chose de ce genre ne pourrait pas convenir:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Form_BeforeUpdate(Cancel As Integer)
    Debug.Print "Form_BeforeUpdate"
    If Trim(Nz(Me.LibelleCatalogue, "")) = "" Then
        MsgBox "Indiquer un libellé svp."
        Me.LibelleCatalogue.SetFocus
        Cancel = True
    End If
    If IsNull(Me.DateEnregistrement) Then
        MsgBox "Indiquer une date svp."
        Me.DateEnregistrement.SetFocus
        Cancel = True
    End If
    '--- etc.

Cordialement.

**morobaboumar** · 02/06/2021, 17h56

Bonsoir EricDgn,
Voici comment j'ai adapté votre code à mon cas:

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
 
Private Sub Form_BeforeUpdate(Cancel As Integer)
    'Vérifie que les champs obligatoires ne sont pas vides avant sauvegarde '
    ''If Replace(Nz(Me.Categorie, ""), " ", "") = "" Then
        ''MsgBox "Saisie annulée car au moins un champ obligatoire était vide.", vbExclamation, "***Annulation***"
        ''Form.Undo
        ''Exit Sub
    ''End If
 
'________________________________________________________________________
'========================================================================
    Debug.Print "Form_BeforeUpdate"
    If Trim(Nz(Me.LibelleCatalogue, "")) = "" Then
        MsgBox "Indiquer un libellé svp."
        Me.LibelleCatalogue.SetFocus
        Cancel = True
    End If
    If IsNull(Me.DateEnregistrement) Then
        MsgBox "Indiquer une date svp."
        Me.DateEnregistrement.SetFocus
        Cancel = True
    End If
    If IsNull(Me.Categorie) Then
        MsgBox "Indiquer une Categorie svp."
        Me.Categorie.SetFocus
        Cancel = True
    End If
    If IsNull(Me.ApercuLibelleCategorie) Then
        MsgBox "Indiquer un libellé svp."
        Me.ApercuLibelleCategorie.SetFocus
        Cancel = True
    End If
    '--- etc.
End Sub

Il y a des messages box qui s'affichent successivement. Je souhaiterais plutôt qu'ils soient affichés pas à pas
après le remplissage de chaque zone de texte successive et que le curseur s'arrête sur la dernière zone de texte
non renseignée avant de poursuivre.
Pièce jointe
Cordialement.

**EricDgn** · 03/06/2021, 13h53

Bonjour,

Une façon de faire est d'utiliser les événements "Avant mise à jour" (_BeforeUpdate) et "Sur sortie" (_Exit). A compléter, adapter.

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
Option Compare Database
Option Explicit
 
Private Sub Categorie_AfterUpdate()
    Me.ApercuLibelleCategorie = RamenerLibelleCategorie(Me.Categorie)
End Sub
 
Private Sub Categorie_BeforeUpdate(Cancel As Integer)
    Debug.Print "Categorie_BeforeUpdate", Me.Categorie.OldValue, Me.Categorie.Value
    If IsNull(Me.Categorie.Value) Then
        MsgBox "n° catégorie obligatoire", , "Non admis"
        Cancel = True
        Me.Categorie.Undo
    ElseIf IsNull(Me.Categorie.OldValue) Then
        '--- ok
    Else
        If Me.Categorie.OldValue = Me.Categorie.Value Then
            '--- ok, rien de changé
        ElseIf MsgBox("ATTENTION !!" & vbCrLf & "VOULEZ-VOUS VRAIMENT MODIFIER LA CATEGORIE ?", _
                      vbQuestion + vbYesNo + vbDefaultButton2, "MODIFICATION") = vbNo Then
            Cancel = True
        Else
            '--- ok
        End If
    End If
End Sub
 
Private Sub Categorie_Exit(Cancel As Integer)
    If IsNull(Me.Categorie) Then
        MsgBox "n° catégorie obligatoire", , "Non admis"
        Cancel = True
    End If
End Sub
 
Private Sub DateEnregistrement_BeforeUpdate(Cancel As Integer)
    Debug.Print "DateEnregistrement_BeforeUpdate", Me.DateEnregistrement.OldValue, Me.DateEnregistrement.Value
    If IsNull(Me.DateEnregistrement.Value) Then
        MsgBox "Date obligatoire", , "Non admis"
        Cancel = True
        Me.DateEnregistrement.Undo
    ElseIf IsNull(Me.DateEnregistrement.OldValue) Then
        '--- ok
    Else
        If Me.DateEnregistrement.OldValue = Me.DateEnregistrement.Value Then
            '--- ok, rien de changé
        ElseIf MsgBox("ATTENTION !!" & vbCrLf & "VOULEZ-VOUS VRAIMENT MODIFIER LA DATE ?", _
                      vbQuestion + vbYesNo + vbDefaultButton2, "MODIFICATION") = vbNo Then
            Cancel = True
        Else
            '--- ok
        End If
    End If
End Sub
 
Private Sub DateEnregistrement_DblClick(Cancel As Integer)
    If EstChargé("Tbl_Catologue_Des_Produits") Then
        Forms!Tbl_CmdeVolaillesBetailsProduits_VENTE_BDialogue!NatureDeVente = Me.ID_Catologue
        Forms!Tbl_CmdeVolaillesBetailsProduits_VENTE_BDialogue!NatureDeVente.SetFocus
        DoCmd.Close acForm, "Tbl_Catologue_Des_Produits"
    End If
End Sub
 
Private Sub DateEnregistrement_Exit(Cancel As Integer)
    If IsNull(Me.DateEnregistrement) Then
        MsgBox "Date obligatoire", , "Non admis"
        Cancel = True
    End If
End Sub
 
Private Sub Form_Load()
    DoCmd.MoveSize 100, 1000, 19000, 10000
End Sub
 
Private Sub pointeur() 'position dans la table pour la retrouver après me.requery
    Dim pointeur As Long
    pointeur = Me.CurrentRecord
    Me.Requery
    Me.SelTop = pointeur
End Sub
 
Private Sub LibelleCatalogue_BeforeUpdate(Cancel As Integer)
    Debug.Print "LibelleCatalogue_BeforeUpdate", Me.LibelleCatalogue.OldValue, Me.LibelleCatalogue.Value
    If Tt(Me.LibelleCatalogue.Value) = "" Then
        MsgBox "Libellé obligatoire", , "Non admis"
        Cancel = True
        Me.LibelleCatalogue.Undo
    ElseIf IsNull(Me.LibelleCatalogue.OldValue) Then
        '--- ok
    Else
        If Me.LibelleCatalogue.OldValue = Me.LibelleCatalogue.Value Then
            '--- ok, rien de changé
        ElseIf MsgBox("ATTENTION !!" & vbCrLf & "VOULEZ-VOUS VRAIMENT MODIFIER CET ELEMENT ?", _
                      vbQuestion + vbYesNo + vbDefaultButton2, "MODIFICATION") = vbNo Then
            Cancel = True
        Else
            '--- ok
        End If
    End If
End Sub
 
Private Sub LibelleCatalogue_DblClick(Cancel As Integer)
    If EstChargé("Tbl_Catologue_Des_Produits") Then
        Forms!Tbl_Cmde_Volailles_Betails_et_Produits_BDialogue!Designations_Commande = Me.ID_Catologue
        Forms!Tbl_Cmde_Volailles_Betails_et_Produits_BDialogue!Designations_Commande.SetFocus
        DoCmd.Close acForm, "Tbl_Catologue_Des_Produits"
    End If
End Sub
 
Private Sub LibelleCatalogue_Exit(Cancel As Integer)
    If Tt(Me.LibelleCatalogue.Value) = "" Then
        MsgBox "Libellé obligatoire", , "Non admis"
        Cancel = True
    End If
End Sub
 
Private Function Tt(s As Variant)
    '--- conversion de text ou rich text en texte normal
    '--- supprime les sauts de ligne et les espaces en début ou fin
    Tt = Trim(Replace(Nz(s, ""), vbCrLf, ""))
End Function

Personnellement je n'utilise jamais des champs au format "texte enrichi" pour des données fondamentales. Je n'utiliserais cela que très très exceptionnellement, uniquement pour des données très accessoires.

J'évite aussi systématiquement que la propriété "Effet touche d'entrée" soit "Nouvelle ligne dans champ". Je mets systématiquement "Par défaut" (= pas de saut de ligne). Permettre un saut de ligne dans un champ texte qui n'est affichée qu'avec la hauteur d'une ligne ne peut conduire qu'à des problèmes, l'utilisateur ne voyant pas ce qui se trouve éventuellement dans la 2e ligne ou plus loin.

La fonction Tt() est là pour gérer ces problèmes provoqués par les "rich text" et "saut de ligne".

Cordialement.

**morobaboumar** · 04/06/2021, 01h20

Bonsoir EricDgn,
Je suis entrain d'adapter le code.

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
Option Compare Database
Option Explicit
 
Private Sub Categorie_AfterUpdate()
Me.ApercuLibelleCategorie = RamenerLibelleCategorie(Me.Categorie)
End Sub
 
Private Sub Categorie_BeforeUpdate(Cancel As Integer)
    Debug.Print "Categorie_BeforeUpdate", Me.Categorie.OldValue, Me.Categorie.Value
    If IsNull(Me.Categorie.Value) Then
        MsgBox "n° catégorie obligatoire", , "Non admis"
        Cancel = True
        Me.Categorie.Undo
    ElseIf IsNull(Me.Categorie.OldValue) Then
        '--- ok
    Else
        If Me.Categorie.OldValue = Me.Categorie.Value Then
            '--- ok, rien de changé
        ElseIf MsgBox("ATTENTION !!" & vbCrLf & "VOULEZ-VOUS VRAIMENT MODIFIER LA CATEGORIE ?", _
                      vbQuestion + vbYesNo + vbDefaultButton2, "MODIFICATION") = vbNo Then
            Cancel = True
        Else
            '--- ok
        End If
    End If
 
End Sub
 
Private Sub Categorie_Exit(Cancel As Integer)
    If IsNull(Me.Categorie) Then
        MsgBox "n° catégorie obligatoire", , "Non admis"
        Cancel = True
    End If
 
End Sub
 
 
 
 
Private Sub Categorie_GotFocus()
Dim stDocName As String
    Dim stLinkCriteria As String
    If MsgBox("ATTENTION !!" & vbCrLf & "VOULEZ-VOUS AJOUTER DES INFORMATIONS ?" & vbCrLf & " OUBIEN Y APPORTER UNE MODIFICATION ?", vbQuestion + vbOKCancel + vbDefaultButton2, "AJOUT OU MODIFICATION") = vbCancel Then Exit Sub
    stDocName = "Tbl_CategorieCommandes"
    DoCmd.OpenForm stDocName
End Sub
 
Private Sub DateEnregistrement_BeforeUpdate(Cancel As Integer)
    Debug.Print "DateEnregistrement_BeforeUpdate", Me.DateEnregistrement.OldValue, Me.DateEnregistrement.Value
    If IsNull(Me.DateEnregistrement.Value) Then
        MsgBox "Date obligatoire", , "Non admis"
        Cancel = True
        Me.DateEnregistrement.Undo
    ElseIf IsNull(Me.DateEnregistrement.OldValue) Then
        '--- ok
    Else
        If Me.DateEnregistrement.OldValue = Me.DateEnregistrement.Value Then
            '--- ok, rien de changé
        ElseIf MsgBox("ATTENTION !!" & vbCrLf & "VOULEZ-VOUS VRAIMENT MODIFIER LA DATE ?", _
                      vbQuestion + vbYesNo + vbDefaultButton2, "MODIFICATION") = vbNo Then
            Cancel = True
        Else
            '--- ok
        End If
    End If
End Sub
 
Private Sub DateEnregistrement_DblClick(Cancel As Integer)
    If EstChargé("Tbl_Catologue_Des_Produits") Then
        Forms!Tbl_CmdeVolaillesBetailsProduits_VENTE_BDialogue!NatureDeVente = Me.ID_Catologue
        Forms!Tbl_CmdeVolaillesBetailsProduits_VENTE_BDialogue!NatureDeVente.SetFocus
        DoCmd.Close acForm, "Tbl_Catologue_Des_Produits"
    End If
End Sub
 
Private Sub DateEnregistrement_Exit(Cancel As Integer)
    If IsNull(Me.DateEnregistrement) Then
        MsgBox "Date obligatoire", , "Non admis"
        Cancel = True
    End If
End Sub
 
Private Sub Form_Load()
    DoCmd.MoveSize 100, 1000, 19000, 10000
End Sub
 
Private Sub pointeur() 'position dans la table pour la retrouver après me.requery
    Dim pointeur As Long
    pointeur = Me.CurrentRecord
    Me.Requery
    Me.SelTop = pointeur
End Sub
 
Private Sub LibelleCatalogue_AfterUpdate()
pointeur
End Sub
 
Private Sub LibelleCatalogue_BeforeUpdate(Cancel As Integer)
    Debug.Print "LibelleCatalogue_BeforeUpdate", Me.LibelleCatalogue.OldValue, Me.LibelleCatalogue.Value
    If Tt(Me.LibelleCatalogue.Value) = "" Then
        MsgBox "Libellé obligatoire", , "Non admis"
        Cancel = True
        Me.LibelleCatalogue.Undo
    ElseIf IsNull(Me.LibelleCatalogue.OldValue) Then
        '--- ok
    Else
        If Me.LibelleCatalogue.OldValue = Me.LibelleCatalogue.Value Then
            '--- ok, rien de changé
        ElseIf MsgBox("ATTENTION !!" & vbCrLf & "VOULEZ-VOUS VRAIMENT MODIFIER CET ELEMENT ?", _
                      vbQuestion + vbYesNo + vbDefaultButton2, "MODIFICATION") = vbNo Then
            Cancel = True
        Else
            '--- ok
        End If
    End If
End Sub
 
Private Sub LibelleCatalogue_DblClick(Cancel As Integer)
    If EstChargé("Tbl_Catologue_Des_Produits") Then
        Forms!Tbl_Cmde_Volailles_Betails_et_Produits_BDialogue!Designations_Commande = Me.ID_Catologue
        Forms!Tbl_Cmde_Volailles_Betails_et_Produits_BDialogue!Designations_Commande.SetFocus
        DoCmd.Close acForm, "Tbl_Catologue_Des_Produits"
    End If
End Sub
 
Private Sub LibelleCatalogue_Exit(Cancel As Integer)
    If Tt(Me.LibelleCatalogue.Value) = "" Then
        MsgBox "Libellé obligatoire", , "Non admis"
        Cancel = True
    End If
End Sub
 
Private Function Tt(s As Variant)
    '--- conversion de text ou rich text en texte normal
    '--- supprime les sauts de ligne et les espaces en début ou fin
    Tt = Trim(Replace(Nz(s, ""), vbCrLf, ""))
End Function

Il marche parfaitement.
Mon cas est

Merci infiniment

Saisie dans Sous Formulaire feuille données

IHM

Discussions similaires

Partager

Partager