Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Access Parcourir l'arborescence d'une table

Parcourir l'arborescence d'une table

5 réponses
Avatar
Alain TEYSSEDRE
Bonjour

J'ai une table Famille qui comporte 3 champs:
- RéfAuto = champ Numérique Auto Clé primaire
- RéfParent = Champ numérique
- Nom = Champ Texte

Je souhaite lister dans une variable strString tous les noms des
"descendants" d'un contact
à partir d'un nom choisi dans la liste cboNom (Zone de liste qui contient
tous les noms
de la table)

RéfAuto RéfParent Nom
1 15 Alain
6 1 Noemi
14 1 Daniel
15 0 Marcel
16 14 Bob MORANE
17 0 Albert DUPONTEL



Ex: si cboNom = Alain alors j'ai strString = Alain, Noemi, Daniel

si cboNom = Marcel ==> strString = Marcel, Alain, Noemi, Daniel

Quel est "algorithme" pour dérouler toutes les branches en Amont d'un Nom
choisi ?
(j'ai essayé avec Dlookup mais je n'arrive pas à enchainer les descendants)

merci pour votre aide

Alain
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Alain TEYSSEDRE
Bon je refais la table parceque le tableau n'est pas passé


RéfAuto RéfParent Nom
1 15 Alain
6 1 Noemi
14 1 Daniel
15 0 Marcel
16 14 Bob MORANE
17 0 Albert DUPONTEL


Alain
Avatar
3stone
Salut,

"Alain TEYSSEDRE"
Bon je refais la table parceque le tableau n'est pas passé


RéfAuto RéfParent Nom
1 15 Alain
6 1 Noemi
14 1 Daniel
15 0 Marcel
16 14 Bob MORANE
17 0 Albert DUPONTEL




C'est cela que tu cherche...

http://www.mvps.org/accessfr/modules/mdl0004.htm


PS: Tu vois, je suis... de loin... ;-))


--
A+
Pierre (3stone) Access MVP
--------------------------------------
Une pour tous, tous pour une ;-)
http://users.skynet.be/mpfa/charte.htm
--------------------------------------

Avatar
Alain TEYSSEDRE
"3stone" a écrit dans le message de
news:3fc39226$0$2878$

C'est cela que tu cherche...

http://www.mvps.org/accessfr/modules/mdl0004.htm


PS: Tu vois, je suis... de loin... ;-))



La je dois reconnaitre que j'ai failli être impressionné.

le geste était élégant, ...mais la balle est faute !

En effet la fonction: fConcatChild d'une remarquable ingéniosité ne
parcourt que le
premier niveau d'une arborescence !
Pour extraire tous les nom sur chque niveau ça se complique , tu me suis ?

@+
Alain

Avatar
Michel Walsh
Salut,


Si tu acceptes d'ajouter un enregistrement du genre

0 0 Null

ou

0 Null Null


alors la fonction suivante te permettra de créer un "nested sets" (ensembles
imbriqués) dans une table, pur illustration, disons table1. Avoir alors tous
les parents d'un noeud, x, est équivalent à

SELECT y.NodeID
FROM table1 AS y INNER JOIN table1 As x
ON x.lft BETWEEN y.lft AND y.rgt
WHERE x.NodeID= [ qui ]
ORDER BY y.lft


Si, aucune récursion, aucune itération.

On peut alors faire un Join( ) ( fonction prédéfinie en VBA 6 ) ou un
GetString ( sur recordsets de type ADO ) pour avoir la liste des parents de
[ qui ], en une chaîne...


Voici la signature de la fonction, FromParentToNested, qui te permet de
créer la table nested sets :

Public Sub FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)

ParentTable est le nom de la table enfant-parent.
NodeID est, pour cette fonction, le nom du champ enfant.
ParentID est le nom du champ parent
NestedSet est le nom de la table de nested sets qui sera créée.


Il faut voir un nested sets comme une "pré-compilation",un peu comme un
index accélère les recherches, mais encore faut-il construire l'index, ici,
construire le nested sets, pour éviter les itérations/récursions.

Mes constantes de message d'erreurs sont en anglais, mais comme on ne fait
pas d'erreur, en français...

============ Option Compare Database
Option Explicit

Private Const MyName As String = "NestedSets"

Private Const errParentTable As String = "Parent Table in error."
Private Const errParentTableKey As String = "Specified 'node' field in
Parent Table has null and so can't be use for primary key."
Private Const errNoRoot As String = "The Parent table has no identifiable
root node; fix and submit again."
Private Const errNoUniqueRoot As String = "The Parent table has more than
one possible root; fix and submit again."
Private Const errCantCreate As String = "Cannot create the nested set table
("
Private Const errCantInsert As String = "Cannot insert the nodeID "
Private Const errUnknownParent As String = "At least one ParentID is unknown
as NodeID in the supplied table."
Private Const errUnusedRecords As String = "Not all the records from the
table have been used."

Private db As Database ' Éviter d'utiliser CurrentDb à chaque fois
Private OpeningString As String ' comment ouvrir un recordset
Private InsertInto As String ' comment insérer un enregistrement
------------------------------------
Private Sub RaiseError(ByVal Desc As String, Optional ErrNumber As Long 513)
Err.Raise vbObjectError + ErrNumber, MyName, Desc
End Sub
------------------------------------
Public Sub FromNestedToParent(ByVal NestedTable As String, _
ByVal ParentTableName As String, _
ByVal NodeFieldName As String, _
ByVal ParentFieldName As String)

Dim db As Database: Set db = CurrentDb
On Error Resume Next
db.Execute "DROP TABLE " & ParentTableName
Err.Clear

db.Execute "SELECT c.NodeID as " & NodeFieldName & _
", p.NodeID As " & ParentFieldName & _
" INTO " & ParentTableName & _
" FROM " & NestedTable & " AS c LEFT JOIN " & NestedTable & " AS p "
& _
" ON (c.lft BETWEEN p.lft AND p.rgt) AND c.lvl = p.lvl+1 ",
dbFailOnError

If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
End If
Debug.Assert 0 = Err.Number
End Sub
------------------------------------
Public Sub FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)

Dim nCount As Long

' Vérifier si les objets référencés existent...
On Error Resume Next
DCount "*", ParentTable, NodeID & "=" & ParentID
If 0 <> Err.Number Then
RaiseError errParentTable
Exit Sub
End If

' Vérifier s'il y a des NULL sous le NodeID
If 0 <> DCount("*", ParentTable, NodeID & " IS NULL") Then
RaiseError errParentTableKey
Exit Sub
End If

Set db = CurrentDb

If 0 <> db.OpenRecordset("SELECT COUNT(*) FROM (SELECT * FROM " & _
ParentTable & " AS a LEFT JOIN " & _
ParentTable & " AS b ON a." & ParentID & "= b." & NodeID & _
" WHERE (NOT a." & ParentID & " IS NULL) AND b." & NodeID & " IS
NULL)").Fields(0).Value Then
RaiseError errUnknownParent
Exit Sub
End If


' Créer la table des nested sets.
db.Execute "DROP TABLE " & NestedSet: Err.Clear
' We tried to drop a table, maybe it was not there... not important...

db.Execute "CREATE TABLE " & NestedSet & _
"(NodeID LONG CONSTRAINT PrimaryKey PRIMARY KEY," & _
" lft LONG NOT NULL CONSTRAINT UniqueLft UNIQUE, " & _
" rgt LONG NOT NULL CONSTRAINT UniqueRgt UNIQUE, " & _
" lvl LONG NOT NULL ); "

' en 'théorie, on peut calculer le niveau, lvl, lorsque requis,
' mais puisqu'on peut également le calculer maintenant...
If 0 <> Err.Number Then
RaiseError errCantCreate & Err.Description & ")."
Exit Sub
End If


' Trouver le noeud ayant Null comme ParentID, ou lui-même.
Dim root As Long
Select Case DCount("*", ParentTable, NodeID & "=" & ParentID)

Case 0
' Il n'y a pas de NodeID=ParentID...rechercher Parent Is Null
Select Case DCount("*", ParentTable, ParentID & " IS Null")
Case 0
' pas de Parent Is Null, ... erreur...
RaiseError errNoRoot
Exit Sub

Case 1
' il n'y a qu'un seul candidat, parfait...
root = DLookup(NodeID, ParentTable, ParentID & " IS NULL")

Case Else
' trop de candidats, que faire?
RaiseError errNoUniqueRoot
Exit Sub
End Select

Case 1

' il y a un seul enregistrement parentID=NodeID...
' mais y a-t-il un NULL comme parent???
If 0 <> DCount("*", ParentTable, ParentID & " Is Null") Then
RaiseError errNoUniqueRoot
Exit Sub
End If

root = DLookup(NodeID, ParentTable, ParentID & "=" & NodeID)

Case Else

' trop de candidats ( nodeId=parentID)...
RaiseError errNoUniqueRoot
Exit Sub

End Select



If 0 <> Err.Number Then
RaiseError errCantInsert & root
Exit Sub
End If

' Prépare la récursion
InsertInto = "INSERT INTO " & NestedSet & "(NodeID, lft, rgt, lvl)
VALUES("
OpeningString = "SELECT " & NodeID & " FROM " & ParentTable & " WHERE "
& ParentID & "="

Dim counting As Long
counting = 2


' Infâme récursion sur chaque enfant...
CallChildren root, counting, 2

' rajoute la racine au tout...
db.Execute InsertInto & root & ", 1, " & counting & ", 1 ); "

' C'est fini. Ne permettons plus de NULL sous rgt...

db.Execute "CREATE INDEX level ON " & NestedSet & "(lvl)"

If counting <> 2 * DCount("*", ParentTable) Then
RaiseError errUnusedRecords
Exit Sub
End If

If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
Exit Sub
End If


End Sub
---------------------------------
Private Sub CallChildren(ByVal ParentNodeID As Long, ByRef counting As Long,
ByVal level As Long)

Dim rst As DAO.Recordset
Dim opening As Long ' le décompte du ver, la valeur lft
' pour un noeud donné
On Error Resume Next
' Ouvre un recordset avec tous les enfants d'un parent donné.
Set rst = db.OpenRecordset(OpeningString & ParentNodeID,
dbOpenForwardOnly, dbReadOnly)

' Pour chaque enreg., se rappeler du lft, récursion sur l'enfant
' en retour, capturer le comptuer du ver, la valeur rgt
' et insérer l'enregistrement... tout simplement:
Do Until rst.EOF

opening = counting ' ma copie du comptuer, ma valeur lft

' il faut incrémenter le compteur du ver...
counting = counting + 1

CallChildren rst.Fields(0).Value, counting, level + 1 ' récursion

' insertion de l'enregistrement actuel
db.Execute InsertInto & rst.Fields(0).Value & ", " & opening & ", "
& counting & ", " & level & ") ;"

' augement le compteur du ver
counting = counting + 1
rst.MoveNext

Loop
Debug.Assert 0 = Err.Number
End Sub
--------------------------------

================================



Espérant être utile,
Vanderghast, Access MVP


"Alain TEYSSEDRE" wrote in message
news:%23PJJJz%

"3stone" a écrit dans le message de
news:3fc39226$0$2878$

C'est cela que tu cherche...

http://www.mvps.org/accessfr/modules/mdl0004.htm


PS: Tu vois, je suis... de loin... ;-))



La je dois reconnaitre que j'ai failli être impressionné.

le geste était élégant, ...mais la balle est faute !

En effet la fonction: fConcatChild d'une remarquable ingéniosité ne
parcourt que le
premier niveau d'une arborescence !
Pour extraire tous les nom sur chque niveau ça se complique , tu me suis ?

@+
Alain







Avatar
Alain TEYSSEDRE
Bonjour Michel

Super Génial ton code , j'ai d'une part réussi à obtenir ce que je voulais
mais
en plus ça m'a donné des idées pour d'autre fonctionnalités dans mon appli
... à suivre
(mais plus tard car j'ai encore du Taff sur plein de trucs)

MERCI

Alain


"Michel Walsh" a écrit dans le message
de news:%
Salut,


Si tu acceptes d'ajouter un enregistrement du genre

0 0 Null

ou

0 Null Null


alors la fonction suivante te permettra de créer un "nested sets"
(ensembles

imbriqués) dans une table, pur illustration, disons table1. Avoir alors
tous

les parents d'un noeud, x, est équivalent à

SELECT y.NodeID
FROM table1 AS y INNER JOIN table1 As x
ON x.lft BETWEEN y.lft AND y.rgt
WHERE x.NodeID= [ qui ]
ORDER BY y.lft


Si, aucune récursion, aucune itération.

On peut alors faire un Join( ) ( fonction prédéfinie en VBA 6 ) ou un
GetString ( sur recordsets de type ADO ) pour avoir la liste des parents
de

[ qui ], en une chaîne...


Voici la signature de la fonction, FromParentToNested, qui te permet de
créer la table nested sets :

Public Sub FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)

ParentTable est le nom de la table enfant-parent.
NodeID est, pour cette fonction, le nom du champ enfant.
ParentID est le nom du champ parent
NestedSet est le nom de la table de nested sets qui sera créée.


Il faut voir un nested sets comme une "pré-compilation",un peu comme un
index accélère les recherches, mais encore faut-il construire l'index,
ici,

construire le nested sets, pour éviter les itérations/récursions.

Mes constantes de message d'erreurs sont en anglais, mais comme on ne fait
pas d'erreur, en français...

============ > Option Compare Database
Option Explicit

Private Const MyName As String = "NestedSets"

Private Const errParentTable As String = "Parent Table in error."
Private Const errParentTableKey As String = "Specified 'node' field in
Parent Table has null and so can't be use for primary key."
Private Const errNoRoot As String = "The Parent table has no identifiable
root node; fix and submit again."
Private Const errNoUniqueRoot As String = "The Parent table has more than
one possible root; fix and submit again."
Private Const errCantCreate As String = "Cannot create the nested set
table

("
Private Const errCantInsert As String = "Cannot insert the nodeID "
Private Const errUnknownParent As String = "At least one ParentID is
unknown

as NodeID in the supplied table."
Private Const errUnusedRecords As String = "Not all the records from the
table have been used."

Private db As Database ' Éviter d'utiliser CurrentDb à chaque
fois

Private OpeningString As String ' comment ouvrir un recordset
Private InsertInto As String ' comment insérer un enregistrement
------------------------------------
Private Sub RaiseError(ByVal Desc As String, Optional ErrNumber As Long > 513)
Err.Raise vbObjectError + ErrNumber, MyName, Desc
End Sub
------------------------------------
Public Sub FromNestedToParent(ByVal NestedTable As String, _
ByVal ParentTableName As String, _
ByVal NodeFieldName As String, _
ByVal ParentFieldName As String)

Dim db As Database: Set db = CurrentDb
On Error Resume Next
db.Execute "DROP TABLE " & ParentTableName
Err.Clear

db.Execute "SELECT c.NodeID as " & NodeFieldName & _
", p.NodeID As " & ParentFieldName & _
" INTO " & ParentTableName & _
" FROM " & NestedTable & " AS c LEFT JOIN " & NestedTable & " AS p
"

& _
" ON (c.lft BETWEEN p.lft AND p.rgt) AND c.lvl = p.lvl+1 ",
dbFailOnError

If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
End If
Debug.Assert 0 = Err.Number
End Sub
------------------------------------
Public Sub FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)

Dim nCount As Long

' Vérifier si les objets référencés existent...
On Error Resume Next
DCount "*", ParentTable, NodeID & "=" & ParentID
If 0 <> Err.Number Then
RaiseError errParentTable
Exit Sub
End If

' Vérifier s'il y a des NULL sous le NodeID
If 0 <> DCount("*", ParentTable, NodeID & " IS NULL") Then
RaiseError errParentTableKey
Exit Sub
End If

Set db = CurrentDb

If 0 <> db.OpenRecordset("SELECT COUNT(*) FROM (SELECT * FROM " & _
ParentTable & " AS a LEFT JOIN " & _
ParentTable & " AS b ON a." & ParentID & "= b." & NodeID & _
" WHERE (NOT a." & ParentID & " IS NULL) AND b." & NodeID & " IS
NULL)").Fields(0).Value Then
RaiseError errUnknownParent
Exit Sub
End If


' Créer la table des nested sets.
db.Execute "DROP TABLE " & NestedSet: Err.Clear
' We tried to drop a table, maybe it was not there... not important...

db.Execute "CREATE TABLE " & NestedSet & _
"(NodeID LONG CONSTRAINT PrimaryKey PRIMARY KEY," & _
" lft LONG NOT NULL CONSTRAINT UniqueLft UNIQUE, " & _
" rgt LONG NOT NULL CONSTRAINT UniqueRgt UNIQUE, " & _
" lvl LONG NOT NULL ); "

' en 'théorie, on peut calculer le niveau, lvl, lorsque requis,
' mais puisqu'on peut également le calculer maintenant...
If 0 <> Err.Number Then
RaiseError errCantCreate & Err.Description & ")."
Exit Sub
End If


' Trouver le noeud ayant Null comme ParentID, ou lui-même.
Dim root As Long
Select Case DCount("*", ParentTable, NodeID & "=" & ParentID)

Case 0
' Il n'y a pas de NodeID=ParentID...rechercher Parent Is Null
Select Case DCount("*", ParentTable, ParentID & " IS Null")
Case 0
' pas de Parent Is Null, ... erreur...
RaiseError errNoRoot
Exit Sub

Case 1
' il n'y a qu'un seul candidat, parfait...
root = DLookup(NodeID, ParentTable, ParentID & " IS NULL")

Case Else
' trop de candidats, que faire?
RaiseError errNoUniqueRoot
Exit Sub
End Select

Case 1

' il y a un seul enregistrement parentID=NodeID...
' mais y a-t-il un NULL comme parent???
If 0 <> DCount("*", ParentTable, ParentID & " Is Null") Then
RaiseError errNoUniqueRoot
Exit Sub
End If

root = DLookup(NodeID, ParentTable, ParentID & "=" & NodeID)

Case Else

' trop de candidats ( nodeId=parentID)...
RaiseError errNoUniqueRoot
Exit Sub

End Select



If 0 <> Err.Number Then
RaiseError errCantInsert & root
Exit Sub
End If

' Prépare la récursion
InsertInto = "INSERT INTO " & NestedSet & "(NodeID, lft, rgt, lvl)
VALUES("
OpeningString = "SELECT " & NodeID & " FROM " & ParentTable & " WHERE
"

& ParentID & "="

Dim counting As Long
counting = 2


' Infâme récursion sur chaque enfant...
CallChildren root, counting, 2

' rajoute la racine au tout...
db.Execute InsertInto & root & ", 1, " & counting & ", 1 ); "

' C'est fini. Ne permettons plus de NULL sous rgt...

db.Execute "CREATE INDEX level ON " & NestedSet & "(lvl)"

If counting <> 2 * DCount("*", ParentTable) Then
RaiseError errUnusedRecords
Exit Sub
End If

If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
Exit Sub
End If


End Sub
---------------------------------
Private Sub CallChildren(ByVal ParentNodeID As Long, ByRef counting As
Long,

ByVal level As Long)

Dim rst As DAO.Recordset
Dim opening As Long ' le décompte du ver, la valeur lft
' pour un noeud donné
On Error Resume Next
' Ouvre un recordset avec tous les enfants d'un parent donné.
Set rst = db.OpenRecordset(OpeningString & ParentNodeID,
dbOpenForwardOnly, dbReadOnly)

' Pour chaque enreg., se rappeler du lft, récursion sur l'enfant
' en retour, capturer le comptuer du ver, la valeur rgt
' et insérer l'enregistrement... tout simplement:
Do Until rst.EOF

opening = counting ' ma copie du comptuer, ma valeur lft

' il faut incrémenter le compteur du ver...
counting = counting + 1

CallChildren rst.Fields(0).Value, counting, level + 1 ' récursion

' insertion de l'enregistrement actuel
db.Execute InsertInto & rst.Fields(0).Value & ", " & opening & ",
"

& counting & ", " & level & ") ;"

' augement le compteur du ver
counting = counting + 1
rst.MoveNext

Loop
Debug.Assert 0 = Err.Number
End Sub
--------------------------------

================================ >



Espérant être utile,
Vanderghast, Access MVP


"Alain TEYSSEDRE" wrote in message
news:%23PJJJz%

"3stone" a écrit dans le message de
news:3fc39226$0$2878$

C'est cela que tu cherche...

http://www.mvps.org/accessfr/modules/mdl0004.htm


PS: Tu vois, je suis... de loin... ;-))



La je dois reconnaitre que j'ai failli être impressionné.

le geste était élégant, ...mais la balle est faute !

En effet la fonction: fConcatChild d'une remarquable ingéniosité ne
parcourt que le
premier niveau d'une arborescence !
Pour extraire tous les nom sur chque niveau ça se complique , tu me suis
?



@+
Alain