Classification des données et structures arborescentes avec Access

SELECT T_Article.IdArticle, T_Article.RefArticle, T_Article.DesignationArticle, T_GroupeArticle.DesignationGroupeArticle AS GroupeArticle, T_FamilleArticle.DesignationFamilleArticle AS FamilleArticle, T_SousFamilleArticle.DesignationSousFamilleArticle AS SousFamilleArticle
FROM ((T_Article INNER JOIN T_GroupeArticle ON T_Article.GroupeArticle = T_GroupeArticle.IDGroupeArticle) INNER JOIN T_FamilleArticle ON T_Article.FamilleArticle = T_FamilleArticle.IDFamilleArticle) INNER JOIN T_SousFamilleArticle ON T_Article.SousFamilleArticle = T_SousFamilleArticle.IDSousFamilleArticle
ORDER BY T_GroupeArticle.RefGroupeArticle, T_FamilleArticle.RefFamilleArticle, T_SousFamilleArticle.RefSousFamilleArticle, T_Article.IdArticle;

SELECT T_ClasseAnimale.IdClasse, T_ClasseAnimale.NomClasse, T_ClasseAnimale_1.NomClasse AS ClasseMere
FROM T_ClasseAnimale LEFT JOIN T_ClasseAnimale AS T_ClasseAnimale_1 ON T_ClasseAnimale.IDClasseAppartenance = T_ClasseAnimale_1.IdClasse
ORDER BY T_ClasseAnimale.IdClasse;

'*********************************************************************************************************************
'**********************Fonction récursive pour générer l'arbre des classes à partir des données***********************
'*********************************************************************************************************************
Public Function ClassificationAnim(rs As DAO.Recordset, idClasseAppartenance As Long, t As CtrlTree)
    'rs : recordset relié à la requête R_ClassesAnimales pour afficher les classes et leur appartenance
    'idClasseAppartenance : identifiant de la classe principale
    't : contrôle CtrlTree dans lequel on va afficher la classification
    Dim debut As Variant ' variable pour enregistrer le signet de début
    Dim idClasse As Long ' variable contenant l'identifiant de la classe
    Dim classe As String ' variable contenant le nom de la classe

    debut = rs.Bookmark ' sauvegarde du pointeur de début

    rs.FindFirst "(IDClasseAppartenance=" + CStr(idClasseAppartenance) + ")" ' recherche de la 1re sous-classe animale
      
    Do While Not rs.NoMatch ' parcours des sous-classes
        idClasse = rs!idClasse ' copie de l'identifiant de la classe dans la variable
        classe = rs!Nomclasse ' copie du nom de la classe dans la variable
        
        t.ElementAdd classe, CStr(idClasse), CStr(idClasseAppartenance) ' ajout de la classe animale sur un noeud de l'arbre
        
        ClassificationAnim rs, idClasse, t  ' appel récursif de la fonction pour IdClasse
        
        rs.FindNext "(IDClasseAppartenance=" + CStr(idClasseAppartenance) + ")"  ' recherche de la prochaine sous-classe animale
    Loop

    rs.Bookmark = debut ' retour au début

End Function

'*********************************************************************************************************************
'**********************Fonction appelante pour générer l'arbre des classes à partir des données***********************
'*********************************************************************************************************************
Public Function GenererClassificationAnim(t As CtrlTree)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Set db = CurrentDb
    Set rs = db.OpenRecordset("T_ClasseAnimale", dbOpenSnapshot) ' ouverture de la requête

    rs.FindFirst ("IsNull([IDClasseAppartenance])") ' position à la racine, classe animale sans ascendants

    t.ElementAdd rs!Nomclasse, CStr(rs!idClasse) ' ajout de la classe à la racine de l'arbre

    Call ClassificationAnim(rs, rs!idClasse, t) ' appel de la fonction récursive

    ' Libération des variables
    rs.Close
    Set rs = Nothing

    Set db = Nothing

End Function

'*********************************************************************************************************************
'********************Fonction appelante v2 pour générer l'arbre des classes à partir des données**********************
'*********************************************************************************************************************
Public Function GenererClassificationAnim2(t As CtrlTree)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Set db = CurrentDb
    Set rs = db.OpenRecordset("T_ClasseAnimale", dbOpenSnapshot) ' ouverture de la requête

    rs.FindFirst ("IsNull([IDClasseAppartenance])") ' position à une racine, classe animale sans ascendants

    Do Until rs.NoMatch ' Boucle sur les racines de l'arbre
        t.ElementAdd rs!Nomclasse, CStr(rs!idClasse) ' ajout de la classe à une racine de l'arbre
        Call ClassificationAnim(rs, rs!idClasse, t) ' appel de la fonction récursive
        rs.FindNext ("IsNull([IDClasseAppartenance])") ' recherche de la prochaine racine
    Loop

    ' Libération des variables
    rs.Close
    Set rs = Nothing

    Set db = Nothing

End Function

SELECT T_Personne.NumPersonne AS IDPersonne, T_Personne.NomPersonne, T_Personne.PrenomPersonne, T_Personne.Sexe, T_Personne.IDPere, [T_Personne_1].[NomPersonne] & " " & [T_Personne_1].[PrenomPersonne] AS Pere, T_Personne.IDMere, [T_Personne_2].[NomPersonne] & " " & [T_Personne_2].[PrenomPersonne] AS Mere, (IsNull([T_Personne].[IDPere]) And IsNull([T_Personne].[IDMere])) AS Racine
FROM (T_Personne LEFT JOIN T_Personne AS T_Personne_1 ON T_Personne.IDPere = T_Personne_1.NumPersonne) LEFT JOIN T_Personne AS T_Personne_2 ON T_Personne.IDMere = T_Personne_2.NumPersonne;

'*********************************************************************************************************************
'*********************Fonction récursive pour générer l'arbre généalogique à partir des données***********************
'*********************************************************************************************************************
Public Function ArbreGen(rs As DAO.Recordset, idPere As Long, idMere As Long, t As CtrlTree)
    'rs : recordset relié à la requête R_Personnes pour afficher les personnes et leurs liens
    'idPere : identifiant du père
    'idMere : identifiant de la mère
    't : contrôle treeview dans lequel on va afficher l'arbre généalogique
    Dim debut As Variant ' variable pour enregistrer le signet de début
    Dim idPersonne As Long, idConjoint As Long ' identifiants du couple
    Dim couple As String ' variable contenant les noms et prénoms des parents
    
    debut = rs.Bookmark ' copie du pointeur de début
    
    rs.FindFirst "(IDPere=" + CStr(idPere) + ") and " + "(IDMere=" + CStr(idMere) + ")" ' recherche du 1er enfant des parents
      
    Do While Not rs.NoMatch ' parcours des enfants
        
        ' on identifie la personne et son conjoint
        idPersonne = rs!idPersonne: idConjoint = 0
        couple = rs!nomPersonne & " " & rs!prenomPersonne
        
        IdentCouple rs, idPersonne, idConjoint, couple, t ' on identifie le couple avec l'identifiant de la personne
        
        ' ajout de la personne et de son conjoint sur un noeud de l'arbre
        t.ElementAdd couple, CStr(idPersonne) & "-" & CStr(idConjoint), CStr(idPere) & "-" & CStr(idMere)
        Call ArbreGen(rs, idPersonne, idConjoint, t)   ' appel de la fonction récursive
        
        rs.FindNext "(IDPere=" + CStr(idPere) + ") and " + "(IDMere=" + CStr(idMere) + ")" ' recherche du prochain enfant
      
    Loop

    rs.Bookmark = debut ' retour au début

End Function

'*********************************************************************************************************************
'*********************Fonction appelante pour générer l'arbre généalogique à partir des données***********************
'*********************************************************************************************************************
Public Function GenererArbreGen(t As CtrlTree)
    Dim db As DAO.Database ' référence à la base courante
    Dim rs As DAO.Recordset ' variable recordset
    Dim idPersonne As Long, idConjoint As Long ' identifiants du couple
    Dim couple As String ' variable contenant les noms et prénoms des parents
    
    Set db = CurrentDb ' référence à la base courante
    Set rs = db.OpenRecordset("R_Personnes", dbOpenSnapshot) ' ouverture du recordset basé sur la requête R_Personnes
    
    rs.FindFirst ("Racine=true") ' position à la racine, personnes sans parents mentionnés
    
    Do While Not rs.NoMatch ' parcours des racines
    
        idPersonne = rs!idPersonne: idConjoint = 0 ' initialisation des identifiants du couple
        couple = rs!nomPersonne & " " & rs!prenomPersonne
        
        IdentCouple rs, idPersonne, idConjoint, couple, t ' on identifie le couple avec l'identifiant de la personne
        
        If (idPersonne <> 0) And (idConjoint <> 0) Then
            t.ElementAdd couple, CStr(idPersonne) & "-" & CStr(idConjoint)  ' ajout de la personne et son conjoint à la racine de l'arbre
            Call ArbreGen(rs, idPersonne, idConjoint, t)   ' appel de la fonction récursive
        End If
        
        rs.FindNext ("Racine=true") ' recherche prochaine racine
    
    Loop
    
    ' Libération des variables
    rs.Close
    Set rs = Nothing
    
    Set db = Nothing

End Function