Not in List – Absence dans une Liste – Novembre 2009
Exposé : Pouvoir ajouter des données dans une table lorsque ces données ne se retrouvent pas dans une liste déroulante bâtie sur un champ.
Point de départ : 4 tables qui vont nous permettre de gérer des travaux commandés par un client et exécutés par des employés.
Les trois premières tables vont nous permettre de remplir la quatrième en utilisant des listes déroulantes. Des requêtes simples sont bâties sur ces tables. Nous bâtissons aussi une cinquième requête de manière à regrouper et afficher la liste de travaux de manière unique. La particularité de cette base de données est que nous travaillons avec des relations « plusieurs à plusieurs » (plusieurs travaux peuvent être exécutés par plusieurs employés) mais ce n’est pas le point le plus important dont nous voulons débattre ici. Ce qui nous intéresse, c’est la méthode qui nous permet de constater l’absence d’une donnée dans une liste déroulante et de provoquer par du code la mise à jour de cette liste.
Le code du bouton « Tous les enregistrements »
Private Sub btnTous_Click()
DoCmd.ShowAllRecords
End Sub
Le code de la liste déroulante « Recherche »
Private Sub CboRecherche_AfterUpdate()
DoCmd.ApplyFilter , "IdTravaux = " & CboRecherche.Column(0)
CboRecherche = ""
End Sub
il faut d’abord régler une propriété du champ dans le formulaire
Le code pour les listes déroulantes, ici pour le champ IdClient, c’est le même mécanisme pour les autres listes
Private Sub IdClient_NotInList(NewData As String, Response As Integer)
Dim db As DAO.Database
Dim NewNbr As Integer
Set db = Application.CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("Q_Clients", dbOpenDynaset)
If rs.RecordCount > 0 Then
rs.MoveLast
NewNbr = rs![idClient] + 1
Else
NewNbr = 1
End If
Dim i As Integer
Dim Msg As String
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' ne fait pas partie actuellement de la liste." & vbCr & vbCr
Msg = Msg & "Voulez-vous l'ajouter?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Item inconnu...")
If i = vbYes Then
rs.AddNew
rs("IdClient") = NewNbr
rs("NomClient") = NewData
rs.Update
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Finalement on doit faire la mise à jour de la liste déroulante de recherche
Private Sub CboRecherche_Enter()
Me.CboRecherche.Requery
End Sub
Cliquez ici pour télécharger le fichier NotInList.zip