Not in List

Retour vers Access

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

Fin