FAQ access 2007

FAQ access 2007Consultez toutes les FAQ
Nombre d'auteurs : 1, nombre de questions : 75, dernière mise à jour : 15 juin 2021
Sommaire→Champs multi-valués→VBA- Comment compter le nombre de valeurs d'un champ multi-valué en VBA ?
- Comment savoir si un champ accepte les valeurs multiples ?
- Comment supprimer toutes les valeurs d'un champs multi-valué en VBA ?
- Comment supprimer une valeur d'un champs multi-valué en VBA ?
- Comment ajouter une valeur d'un champs multi-valué en VBA ?
- Comment créer un champ à valeurs multiples de type "Liste de valeurs" ?
- Comment créer un champ à valeurs multiples de type "Table/requête" ?
- Comment convertir un champ multiple en relation 1 à plusieurs ?
- Comment dupliquer un champ multi-valué en VBA ?
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
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 SubIl ne faut pas oublier que la propriété Value d'un champ multi-valué retourne un Recordset.
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é.
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 SubSoit 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
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 SubComme vous pouvez le constater, il suffit de boucler sur l'ensemble des enregistrements du Recordset retourné par le champ multi-valué.
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 :
- Accéder à l'enregistrement correspondant au chauffeur n°2
- Rechercher la valeur D dans le champ multi-valué
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 SubLien : 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 :
- Accéder à l'enregistrement correspondant au chauffeur n°2
- Ajouter la valeur D dans le champ multi-valué
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 SubSi 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.
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 SubLien : 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 :
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 SubL'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.
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 :
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 SubL'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.
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 :
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 :
'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.
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 oTblA ce stade, il est possible d'insérer les données :
'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
WendEnfin, reste la création de la relation
'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 oRelIl 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 :
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 SubSoit 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.
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 SubLe champ NumChauffeur est à éviter pour laisser Access gérer l'incrémentation automatique.



