IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

FAQ access 2007

FAQ access 2007Consultez toutes les FAQ

Nombre d'auteurs : 1, nombre de questions : 75, dernière mise à jour : 15 juin 2021 

 
OuvrirSommaireChamps multi-valuésVBA

Soit la table suivante :

  • NumChauffeur : NuméroAuto
  • NomChauffeur : Texte(20)
  • PrenomChauffeur : Texte(20)
  • PermisChauffeur : Texte(1) - Liste de choix de valeurs : A;B;C;D;E - Valeurs multiples autorisées

La requête suivante retourne le nombre de permis du chauffeur n°2

 
Sélectionnez
Sub S02_ChampMultiValueNb()
Dim oRst As DAO.Recordset
Set oRst = CurrentDb.OpenRecordset("SELECT PermisChauffeur FROM tbl_chauffeur WHERE NumChauffeur=2")
With oRst
  If Not .EOF Then
    With .Fields(0).Value
      .MoveLast
      MsgBox "Nombre de permis du chauffeur n°2 : " & .RecordCount
    End With
  Else
    MsgBox "Ce chauffeur n'existe pas"
  End If
End With
End Sub

Il ne faut pas oublier que la propriété Value d'un champ multi-valué retourne un Recordset.

Créé le 27 juin 2006  par Christophe Warin

Lien : Comment savoir si un champ multi-valué est vide en SQL ?
Lien : Comment compter le nombre de valeurs distinctes d'un champ multi-valué sur l'ensemble la table en SQL ?
Lien : Comment compter le nombre de valeur d'un champ multi-valué en SQL?

Lorsqu'un champ accepte les valeurs multiples, sa propriété DAO AllowMultipleValues est égale à True. Il est donc simple, à priori, de savoir si le champ est multi-valué ou non. Mais attention, si lors de la création du champ vous n'avez pas renseigné l'onglet Liste de Choix, cette propriété n'existe pas. Il faut donc s'attendre à une éventuelle erreur à intercepter.

Voici un exemple de code prenant en compte cette éventualité.

 
Sélectionnez
Sub S01_ChampIsMultiValue()
On Error GoTo err
Dim oDb As DAO.Database
Set oDb = CurrentDb
If oDb.TableDefs("tbl_Chauffeur").Fields("NumChauffeur").Properties("AllowMultipleValues") Then
  MsgBox "Valeurs multiples autorisées"
Else
  MsgBox "Valeurs multiples interdites"
End If
 
fin:
Set oDb = Nothing
Exit Sub
err:
If err.Number = 3270 Then
  MsgBox "Valeurs multiples interdites"
Else
  MsgBox "Erreur"
End If
Resume fin
End Sub
Créé le 27 juin 2006  par Christophe Warin

Soit la table suivante :

  • NumChauffeur : NuméroAuto
  • NomChauffeur : Texte(20)
  • PrenomChauffeur : Texte(20)
  • PermisChauffeur : Texte(1) - Liste de choix de valeurs : A;B;C;D;E - Valeurs multiples autorisées

Cet exemple va supprimer l'ensemble des permis du chauffeur n°2

 
Sélectionnez
Sub ChampMultiValueSupprimerTous()
Dim oRst As DAO.Recordset
'Selectionne le chauffeur n°2
Set oRst = CurrentDb.OpenRecordset("SELECT PermisChauffeur FROM tbl_chauffeur WHERE NumChauffeur=2")
With oRst
'Si le chauffeur existe
  If Not .EOF Then
    'Accede au champ multivalué et supprime toutes les valeurs
    With .Fields(0).Value
      While Not .EOF
        .Delete
        .MoveNext
      Wend
    End With
  Else
    MsgBox "Ce chauffeur n'existe pas"
  End If
End With
End Sub

Comme vous pouvez le constater, il suffit de boucler sur l'ensemble des enregistrements du Recordset retourné par le champ multi-valué.

Créé le 27 juin 2006  par Christophe Warin

Lien : Comment supprimer une valeur d'un champs multi-valué ?
Lien : Comment supprimer toutes les valeurs d'un champs multi-valué ?

Soit la table suivante :

  • NumChauffeur : NuméroAuto
  • NomChauffeur : Texte(20)
  • PrenomChauffeur : Texte(20)
  • PermisChauffeur : Texte(1) - Liste de choix de valeurs : A;B;C;D;E - Valeurs multiples autorisées

Cet exemple va supprimer le permis D du chauffeur n°2. Deux étapes sont nécessaires :

  1. Accéder à l'enregistrement correspondant au chauffeur n°2
  2. Rechercher la valeur D dans le champ multi-valué
 
Sélectionnez
Sub S02_ChampMultiValueSupprimerUn()
Dim oRst As DAO.Recordset
'Selectionne le chauffeur n°2
Set oRst = CurrentDb.OpenRecordset("SELECT PermisChauffeur FROM tbl_chauffeur WHERE NumChauffeur=2")
With oRst
'Si le chauffeur existe
  If Not .EOF Then
    'Accede au champ multivalué
    With .Fields(0).Value
      'Recherche le permis D
      .FindFirst "value='D'"
      'Si le permis a été trouvé, supprime la ligne
      If Not .NoMatch Then
        .Delete
      End If
    End With
  Else
    MsgBox "Ce chauffeur n'existe pas"
  End If
End With
End Sub
Créé le 27 juin 2006  par Christophe Warin

Lien : Comment supprimer toutes les valeurs d'un champs multi-valué en VBA ?
Lien : Comment supprimer toutes les valeurs d'un champs multi-valué ?
Lien : Comment supprimer une valeur d'un champs multi-valué ?

Soit la table suivante :

  • NumChauffeur : NuméroAuto
  • NomChauffeur : Texte(20)
  • PrenomChauffeur : Texte(20)
  • PermisChauffeur : Texte(1) - Liste de choix de valeurs : A;B;C;D;E - Valeurs multiples autorisées

Cet exemple va ajouter le permis D au chauffeur n°2. Deux étapes sont nécessaires :

  1. Accéder à l'enregistrement correspondant au chauffeur n°2
  2. Ajouter la valeur D dans le champ multi-valué
 
Sélectionnez
Sub S03_ChampMultiValueAjouterUn()
Dim oRst As DAO.Recordset
'Selectionne le chauffeur n°2
Set oRst = CurrentDb.OpenRecordset("SELECT PermisChauffeur FROM tbl_chauffeur WHERE NumChauffeur=2")
With oRst
'Si le chauffeur existe
  If Not .EOF Then
    'Accede au champ multivalué
    With .Fields(0).Value
      'Ajoute la valeur et mets à jour
      .AddNew
      .Fields(0).Value = "D"
      .Update
    End With
  Else
    MsgBox "Ce chauffeur n'existe pas"
  End If
End With
End Sub

Si la valeur existe déjà, l'erreur 3820 sera levée. Il est donc préférable d'intercepter cette erreur avec une routine On Error.

 
Sélectionnez
Sub S03Bis_ChampMultiValueAjouterUn()
On Error GoTo err
Dim oRst As DAO.Recordset
'Selectionne le chauffeur n°2
Set oRst = CurrentDb.OpenRecordset("SELECT PermisChauffeur FROM tbl_chauffeur WHERE NumChauffeur=2")
With oRst
'Si le chauffeur existe
  If Not .EOF Then
    'Accede au champ multivalué
    With .Fields(0).Value
      'Ajoute la valeur et mets à jour
      .AddNew
      .Fields(0).Value = "D"
      .Update
    End With
  Else
    MsgBox "Ce chauffeur n'existe pas"
  End If
End With
 
fin:
Set oRst = Nothing
Exit Sub
 
err:
'Gère l'erreur de doublons
Select Case err.Number
  Case 3820:
    MsgBox "Le chauffeur numéro 2 possède déjà le permis D", vbExclamation
  Case Else:
    MsgBox "Erreur critique", vbCritical
End Select
Resume fin
End Sub
Créé le 27 juin 2006  par Christophe Warin

Lien : Comment savoir si un champ multi-valué est vide en SQL ?

Pour créer un champ acceptant les valeurs multiples en VBA, il faut utiliser les objets DAO Field et Property.

Le comportement : liste de valeurs multiples est obtenue par la combinaison de 4 propriétés :

  • Contrôle à afficher : zone de liste (ListBox) ou zone de liste modifiable (ComboBox)
  • Origine Source : liste de valeurs
  • Contenu : les valeurs séparées par des points-virgules
  • Valeurs multiples autorisées : oui

Par exemple :

 
Sélectionnez
Sub CreerChampMultiValueVBA()
Dim oDb As DAO.Database
Dim oTbl As DAO.TableDef
Dim oFld As DAO.Field
Set oDb = CurrentDb
Set oTbl = oDb.TableDefs("tbl_chauffeur")
'Crée le champ
Set oFld = oTbl.CreateField("Permis", dbText, 1)
'Ajoute le champ à la table
oTbl.Fields.Append oFld
With oFld
  'Définit le contrôle à afficher
  .Properties.Append .CreateProperty("DisplayControl", dbInteger, acComboBox)
  'Autorise les valeurs multiples
  .Properties.Append .CreateProperty("AllowMultipleValues", dbBoolean, True)
  'Définit l'Origine Source
  .Properties.Append .CreateProperty("RowSourceType", dbText, "Value List")
  'Paramètre le contenu
  .Properties.Append .CreateProperty("RowSource", dbText, "B;C;D;E")
End With
 
MsgBox "Champ ajouté"
End Sub

L'ordre d'ajout est important : il faut déjà ajouter le champ à la table et ensuite lui ajouter des propriétés, sans quoi une erreur 3219 sera levée.

Créé le 27 juin 2006  par Christophe Warin

Lien : Comment créer un champ à valeurs multiples de type "Table/requête" ?

Pour créer un champ acceptant les valeurs multiples en VBA, il faut utiliser les objets DAO Field et Property.

Le comportement : liste de valeurs multiples est obtenue par la combinaison de 4 propriétés :

  • Contrôle à afficher : zone de liste (ListBox) ou zone de liste modifiable (ComboBox)
  • Origine Source : Table/Requête
  • Contenu : Le code SQL, le nom de la requête ou celui de la table
  • Colonne liée: L'index de la colonne à enregistrer
  • Valeurs multiples autorisées : oui

Par exemple :

 
Sélectionnez
Sub CreerChampMultiValueVBA()
Dim oDb As DAO.Database
Dim oTbl As DAO.TableDef
Dim oFld As DAO.Field
Set oDb = CurrentDb
Set oTbl = oDb.TableDefs("tbl_chauffeur")
'Crée le champ
Set oFld = oTbl.CreateField("Permis", dbText, 1)
'Ajoute le champ à la table
oTbl.Fields.Append oFld
With oFld
  'Définit le contrôle à afficher
  .Properties.Append .CreateProperty("DisplayControl", dbInteger, acComboBox)
  'Autorise les valeurs multiples
  .Properties.Append .CreateProperty("AllowMultipleValues", dbBoolean, True)
  'Définit l'Origine Source
  .Properties.Append .CreateProperty("RowSourceType", dbText, "Table/Query")
  'Paramètre le contenu
  .Properties.Append .CreateProperty("RowSource", dbText, "SELECT LibPermis,NumPermis FROM Permis")
  'Définie la colonne liée : On veut enregistrer le numéro du permis
  .Properties.Append .CreateProperty("BoundColumn", dbInteger, 1)
 
End With
 
MsgBox "Champ ajouté"
End Sub

L'ordre d'ajout est important : il faut déjà ajouter le champ à la table et ensuite lui ajouter des propriétés, sans quoi une erreur 3219 sera levée.

Créé le 27 juin 2006  par Christophe Warin

Lien : Comment créer un champ à valeurs multiples de type "Liste de valeurs" ?

Soit la table suivante :

  • NumChauffeur : NuméroAuto
  • NomChauffeur : Texte(20)
  • PrenomChauffeur : Texte(20)
  • PermisChauffeur : Texte(1) - Liste de choix de valeurs : A;B;C;D;E - Valeurs multiples autorisées

Cet exemple permet de créer une table tbl_Détenir(NumChauffeur,Permis) dont les champs sont du même type que dans la table tbl_chauffeur. Ce code ajoute aussi la clé primaire et la relation 1 à plusieurs entre les tables.

Pour mener a bien ce projet, il faut manipuler des tables, des index, des champs et des recordset.

La déclaration des variables est la suivante :

 
Sélectionnez
Dim strNomChampMultiple As String, strNomClePrimaire As String
Dim oDb As DAO.Database
Dim oRstSource As DAO.Recordset, orstDestination As DAO.Recordset
Dim oTbl As DAO.TableDef, oRel As DAO.Relation
Dim oFld As DAO.Field, oIdx As DAO.Index
Set oDb = CurrentDb
strNomClePrimaire = "NumChauffeur"
strNomChampMultiple = "PermisChauffeur"

Pour récupérer le recordset correspondant aux permis des chauffeurs, on utilise :

 
Sélectionnez
'Ouvre le recordset source
Set oRstSource = oDb.OpenRecordset("SELECT " & strNomClePrimaire & "," & _
      strNomChampMultiple & ".Value FROM tbl_chauffeur" & " WHERE " & strNomChampMultiple & ".Value IS NOT NULL")

Il faut ensuite créer la table tbl_detenir avec sa clé primaire.

 
Sélectionnez
Set oTbl = oDb.CreateTableDef("tbl_Détenir")
With oTbl
  'Ajoute les deux champs en respectant les types
  .Fields.Append .CreateField(strNomClePrimaire, oRstSource.Fields(0).Type, _
          oRstSource.Fields(0).Size)
  .Fields.Append .CreateField(strNomChampMultiple, oRstSource.Fields(1).Type, _
          oRstSource.Fields(1).Size)
  'Crée la clé primaire
  Set oIdx = oTbl.CreateIndex("PrimaryKey")
  With oIdx
    .Fields.Append .CreateField(strNomClePrimaire)
    .Fields.Append .CreateField(strNomChampMultiple)
    .Primary = True
  End With
  oTbl.Indexes.Append oIdx
End With
'Ajoute la table
oDb.TableDefs.Append oTbl

A ce stade, il est possible d'insérer les données :

 
Sélectionnez
'Ouvre un recordset sur la nouvelle table
Set orstDestination = oTbl.OpenRecordset
'Parcours la table source
While Not oRstSource.EOF
  With orstDestination
    'Ajoute l'enregistrement dans la table de destination
    .AddNew
    .Fields(0).Value = oRstSource.Fields(0).Value
    .Fields(1).Value = oRstSource.Fields(1).Value
    .Update
  End With
  oRstSource.MoveNext
Wend

Enfin, reste la création de la relation

 
Sélectionnez
'Crée la relation
Set oRel = oDb.CreateRelation("DetenirChauffeur", "tbl_Chauffeur", "tbl_Détenir")
With oRel
  Set oFld = .CreateField(strNomClePrimaire)
  oFld.ForeignName = strNomClePrimaire
  oRel.Fields.Append oFld
End With
'Ferme les recordsets
oRstSource.Close: orstDestination.close
Set oRstSource = Nothing: Set orstDestination = Nothing
oDb.Relations.Append oRel

Il est important de fermer les recordset avant d'ajouter la relation car cette opération nécessite un accès exclusif aux tables.

Le code complet :

 
Sélectionnez
Sub ConvertirChampMultiValue()
Dim strNomChampMultiple As String, strNomClePrimaire As String
Dim oDb As DAO.Database
Dim oRstSource As DAO.Recordset, orstDestination As DAO.Recordset
Dim oTbl As DAO.TableDef, oRel As DAO.Relation
Dim oFld As DAO.Field, oIdx As DAO.Index
Set oDb = CurrentDb
strNomClePrimaire = "NumChauffeur"
strNomChampMultiple = "PermisChauffeur"
'Ouvre le recordset source
Set oRstSource = oDb.OpenRecordset("SELECT " & strNomClePrimaire & "," & _
      strNomChampMultiple & ".Value FROM tbl_chauffeur" & " WHERE " & strNomChampMultiple & ".Value IS NOT NULL")
'Crée la table tbl_Détenir
Set oTbl = oDb.CreateTableDef("tbl_Détenir")
With oTbl
  'Ajoute les deux champs en respectant les types
  .Fields.Append .CreateField(strNomClePrimaire, oRstSource.Fields(0).Type, _
          oRstSource.Fields(0).Size)
  .Fields.Append .CreateField(strNomChampMultiple, oRstSource.Fields(1).Type, _
          oRstSource.Fields(1).Size)
  'Crée la clé primaire
  Set oIdx = oTbl.CreateIndex("PrimaryKey")
  With oIdx
    .Fields.Append .CreateField(strNomClePrimaire)
    .Fields.Append .CreateField(strNomChampMultiple)
    .Primary = True
  End With
  oTbl.Indexes.Append oIdx
End With
'Ajoute la table
oDb.TableDefs.Append oTbl
'Ouvre un recordset sur la nouvelle table
Set orstDestination = oTbl.OpenRecordset
'Parcours la table source
While Not oRstSource.EOF
  With orstDestination
    'Ajoute l'enregistrement dans la table de destination
    .AddNew
    .Fields(0).Value = oRstSource.Fields(0).Value
    .Fields(1).Value = oRstSource.Fields(1).Value
    .Update
  End With
  oRstSource.MoveNext
Wend
'Crée la relation
Set oRel = oDb.CreateRelation("DetenirChauffeur", "tbl_Chauffeur", "tbl_Détenir")
With oRel
  Set oFld = .CreateField(strNomClePrimaire)
  oFld.ForeignName = strNomClePrimaire
  oRel.Fields.Append oFld
End With
'Ferme les recordsets
Set oRstSource = Nothing: Set orstDestination = Nothing
oDb.Relations.Append oRel
End Sub
Créé le 27 juin 2006  par Christophe Warin

Soit la table suivante :

  • NumChauffeur : NuméroAuto
  • NomChauffeur : Texte(20)
  • PrenomChauffeur : Texte(20)
  • PermisChauffeur : Texte(1) - Liste de choix de valeurs : A;B;C;D;E - Valeurs multiples autorisées

Cet exemple va dupliquer le chauffeur n°2 ainsi que sa liste de permis.

 
Sélectionnez
Sub duppliquerChampMultiValue()
Dim oRstSource As DAO.Recordset, oRstDestination As DAO.Recordset
Dim oFld As DAO.Field, oRstMulti As DAO.Recordset
Set oRstSource = CurrentDb.OpenRecordset("SELECT * FROM tbl_chauffeur WHERE NumChauffeur=2")
Set oRstDestination = CurrentDb.OpenRecordset("tbl_chauffeur")
'Si le chauffeur existe
If Not oRstSource.EOF Then
  'Ajoute un nouvel enregistrement
  oRstDestination.AddNew
  With oRstSource
    'parcours chaque champ
    For Each oFld In .Fields
      With oFld
        'Traite le cas du champ multivalué
        If .Name = "PermisChauffeur" Then
          'Accède à la liste des permis (recordset)
          With .Value
            'Dupplique chaque permis
            While Not .EOF
              'Recordset des permis du nouvel enregistrement
              Set oRstMulti = oRstDestination.Fields("PermisChauffeur").Value
              oRstMulti.AddNew
              oRstMulti.Fields(0).Value = .Fields(0).Value
              oRstMulti.Update
              .MoveNext
            Wend
          End With
          'Evite le champ NumChauffeur car numéro Auto
        ElseIf .Name <> "NumChauffeur" Then
           oRstDestination.Fields(.Name).Value = .Value
        End If
      End With
    Next oFld
  End With
  'Enregistre le nouveau chauffeur
  oRstDestination.Update
End If
 
End Sub

Le champ NumChauffeur est à éviter pour laisser Access gérer l'incrémentation automatique.

Créé le 27 juin 2006  par Christophe Warin

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2009 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.