Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

TUTORIEL POUR REMPLIR UN TREEVIEW SOUS ACCESS (2000)


Information sur le tutorial

Catégorie :Base de Donnees Date de création : 23/01/2006 09:30:12 Vu : 21 260 fois

Note :
8 / 10 - par 5 personnes
8,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (2)
Ajouter un commentaire et/ou une note

Description

Quelques conseils pour remplir un TreeView à partir d'une table sous Access

Tutorial

 

Comment insérer et remplir un treeview dans un formulaire Access


Insérer un treeview


Tout d'abord, il faut insérer ce contrôle ActiveX : menu Insertion/Contrôle Activex... et choisissez Microsoft TreeView control


Le treeview se place alors sur votre formulaire


Un double clic sur celui-ci vous permet d'éditer ses propriétés spécifiques. Pour éditer ses propriétés par rapport au formulaire, faites ALT + Entrée.


Personnellement, j'utilise les réglages suivants qui font ressembler le treeview à l'arborescence de l'explorateur :

Propriétés du treeview


Ces propriétés peuvent aussi être spécifiées dans le code VBA

Pour personnaliser les icônes utilisées par le treeview, vous pouvez aussi insérer un contrôle ImageList (Microsoft ImageList control). N'oubliez pas de nommer chaque image (key) et choisissez plutôt des images en 16*16.

Détail du contrôle ImageList


La propriété ImageList du TreeView vous permet d'indiquer le nom du contrôle ImageList à utiliser pour les images. Pour notre tutoriel, nous utiliserons deux images (IMG_FOLD et IMG_USER)



Données du treeview


Il faut une table ou une requête. Si vous voulez utiliser une source extérieure de données, du type fichier texte tabulé, vous pouvez utiliser les commandes de l'objet FileSystemObject ou bien importer ce fichier dans une table temporaire.


Ce tutoriel utilise une table qu'on appellera Treeview. Les champs sont les suivants :

N°Entite (numéro auto) – clé primaire

EntiteCourt (texte 16) – Libellé court du noeud

Entite (texte 90) – Libellé long

TypeEntite (texte 8 – liste de choix : 4;"niveau 4";3;"niveau 3";2;"niveau 2";1;"niveau 1")

N°EntiteS (entier long) – Numéro du noeud supérieur (en référence à N°Entite)


La procédure de construction du treeview crée chaque noeud (entité) « parent » et ses « enfants ». Un noeud enfant peut être créé si son parent existe déjà. On utilisera donc une requête « R_Treeview_triee » qui trie les entités par ordre croissant de leur TypeEntite pour éviter un plantage du code.


Ecriture du code


Pour que ça fonctionne bien, votre code vba doit faire référence (Outils/Références...) à :

  • Microsoft Windows Common Controls (c:\windows\system32\MSCOMCTL.OCX)

  • Microsoft DAO 3.6



Sub RemplirTreeviewEntites(Optional EntiteAAfficher As Long)
On Error GoTo ErreursRemplirTreeviewEntites


' définition des variables
Dim trwarbo As TreeView
Dim mynode As Node
Dim Mabase As Database
Dim RSEntites As DAO.Recordset
Dim txtSQL As String
Dim j As Integer

' ouverture de la requête du formulaire en cours

Set Mabase = CurrentDb
txtSQL = "SELECT * FROM R_Treeview_triee;"
Set RSEntites = Mabase.OpenRecordset(txtSQL, dbOpenSnapshot)

' instanciation de l'objet treeview

Set trwarbo = Me.TV1.Object
With trwarbo
   .Nodes.Clear
   
.ImageList = Me.ImageList1.Object
   .
HideSelection = False
   
.HotTracking = True
   
.LineStyle = tvwRootLines
End With


'remplissage du treeview avec le contenu de la requête
Do While Not RSEntites.EOF
      'niveau1
   If IsNull(RSEntites![N°entiteS]) = True Then
      Set mynode = trwarbo.Nodes.Add(, , "Ent" & RSEntites![N°Entite], RSEntites![EntiteCourt], "IMG_FOLD")
      mynode.Bold = True
      mynode.ForeColor = RGB(98, 162, 197)
   Else
      'niveaux2 à 4
      Select Case Left(RSEntites![TypeEntite], 1)
         
Case 2
            
trwarbo.Nodes.Add "Ent" & RSEntites![N°entiteS], tvwChild, "Ent" & RSEntites![N°Entite], RSEntites![EntiteCourt], "IMG_FOLD"
         Case 3
            
trwarbo.Nodes.Add "Ent" & RSEntites![N°entiteS], tvwChild, "Ent" & RSEntites![N°Entite], RSEntites![EntiteCourt], "IMG_FOLD"
         Case 4
            
trwarbo.Nodes.Add "Ent" & RSEntites![N°entiteS], tvwChild, "Ent" & RSEntites![N°Entite], RSEntites![EntiteCourt], "IMG_USER"
      
End Select
   End If
   RSEntites.MoveNext
Loop
trwarbo.Refresh
TV1.Requery

'affichage de du noeud demandé
If EntiteAAfficher <> 0 Then
   
trwarbo.Nodes.Item("Ent" & EntiteAAfficher).Selected = True
Else
   trwarbo.Nodes(1).Selected = True
End If

'libération du recordset
Set RSEntites = Nothing
Exit Sub

ErreursRemplirTreeviewEntites:
Select Case Err
   Case 13 'EntiteCourt est vide
      If IsNull(RSEntites![EntiteCourt]) Then
         
Beep
      
   MsgBox "L'arborescence contenant les Entités ne peut pas s'afficher correctement" & vbCrLf & "car l'entité n° " & RSEntites![N°Entite] & " n'a pas de libellé court." & vbCrLf & vbCrLf & "Vous devez modifier cette entité.", vbCritical, "L'application a rencontré une erreur"
      End If
      Exit Sub
   Case 35601 'N°EntiteS introuvable
      Beep
      MsgBox "L'arborescence contenant les Entités ne peut pas s'afficher correctement" & vbCrLf & "car l'entité n° " & RSEntites![N°Entite] & " (" & RSEntites![EntiteCourt] & ") indique une entité parente qui n'existe pas." & vbCrLf & vbCrLf & "Vous devez modifier cette entité.", vbCritical, "L'application a rencontré une erreur"
      
Exit Sub
   Case Else
      MsgBox "Erreur n° " & Err & " : " & Err.Description, vbCritical
   
Exit Sub
End Select

End Sub


Le paramètre optionnel EntiteAAfficher vous permet de construire le treeview et d'afficher l'entité désirée (par exemple : RemplirTreeviewEntites(25)).


Lorsqu'on crée un noeud dans le treeview (trwarbo.Nodes.Add), on doit lui donner un nom alphanumérique, c'est pourquoi j'ai choisi d'appeler chaque noeud Entxxx, xxx étant le N°Entite.


23 janvier 2006 10:12:45 :
Oubli des images
signaler à un administrateur
Commentaire de TMONOD le 26/02/2006 12:43:20

1/ Il aurait été plus "sympa" de construire des fonctions génériques qui à partir d'un modèle relationnel donne une arborescence de la base de donnée.
(dans mes rêves).
2/ le parcourt d'un arbre (et sa construction) se font plus efficacement à l'aide de la récursivité !!
3/ ...Je prépare une amélioration de ton code pour illustrer les remarques ci-dessus.
Sinon merci quand même !

signaler à un administrateur
Commentaire de TMONOD le 26/02/2006 23:22:12

...me revoilou . Voici le code à inserer dans un module VB. Il est générique. et s'adapte à toute table dont une clé étrangère est uu lien père-fils vers un autre enregistrement de la même table.
Dans le formulaire il suffit d'initialiser le treeview de la manière suivante (adapter les nom des champs et de table à votre cas) :

(ici mon treeview porte le nom TV1)
Sub MajTreeview()
Dim tabledemo As TablePereFilsStruct
'initialisation de la structure
tabledemo.nomtable = "treeview"
tabledemo.nomcle = "N°Entite"
tabledemo.nomclePere = "N°EntiteS"
tabledemo.nomTitreCourt = "EntiteCourt"
InsererTableDansTreeView Me.TV1.Object, tabledemo
End Sub

'----ICI COMMENCE LE MODULE


'Fonctions génériques pour remplir un treeview d'un formulaire à l'aide des données
'd'une table ou d'une requete comportant une clé étrangère récursive
'(relation père-fils vers un enregistrement de la même table)

Option Compare Database
Option Explicit
Type TablePereFilsStruct
    nomtable As String
    nomcle As String
    nomclePere As String
    nomTitreCourt As String
End Type

Type noeudPourTreeView
    cle As String
    pere As String
    nom As String
End Type


'Procedure à appeller dans le formulaire pour mettre à jour le treeview
Sub InsererTableDansTreeView(tv As TreeView, st As TablePereFilsStruct)
InitialiserTreeview tv
'0 est la racine de l'arbre
InsererNoeuds tv, st, ConstruireNoeudAvecCle(st, "0")
End Sub

Sub InitialiserTreeview(tv As TreeView)
With tv
   .Nodes.Clear
   '.ImageList = Me.ImageList1.Object
   .HideSelection = False
   .HotTracking = True
   .LineStyle = tvwRootLines
End With

End Sub

'Ajouter le noeud au treeview puis tous ses fils
Sub InsererNoeuds(tv As TreeView, str As TablePereFilsStruct, lenoeud As noeudPourTreeView)
Dim rst As DAO.Recordset, typenoeud, requete As String, td As DAO.TableDef, typecle

'Si ce n'est pas la racine on l'ajoute au treeview
If lenoeud.cle <> "0" Then
    AjouterNoeudDansTreeView tv, lenoeud, tvwChild
    typenoeud = tvwChild
Else
    typenoeud = Null
End If

'La clé pouvant être numérique ou texte : 2 types de requêtes différentes
'La clé est numérique
'determiner le type du champs clé----------------------------
typecle = GetTypeChamps(str.nomtable, str.nomcle)
'si la clé n'est ni numérique ni text il faudra adapter le select case....

Select Case typecle
Case Is = dbText
    requete = "select [" & str.nomcle _
    & "],[" & str.nomclePere & "],[" _
    & str.nomTitreCourt _
    & "] from [" _
    & str.nomtable & "] where [" & str.nomclePere & "]='" & lenoeud.cle & "' ;"
Case Else
    requete = "select [" & str.nomcle _
    & "],[" & str.nomclePere & "],[" _
    & str.nomTitreCourt _
    & "] from [" _
    & str.nomtable & "] where [" & str.nomclePere & "]=" & Val(lenoeud.cle) & " ;"
End Select

'Parcourt de tous les enfants du noeud
Set rst = CurrentDb.OpenRecordset(requete)
With rst
    While Not .EOF
        'Insertion de chaque enfant et de ses enfants.... avec un appel recursif
        InsererNoeuds tv, str, ConstruireNoeudAvecCle(str, .Fields(str.nomcle))
        .MoveNext
    Wend
    .Close
End With
End Sub
'Ajout du noeud à l'objet treeview
Sub AjouterNoeudDansTreeView(tv As TreeView, noeud As noeudPourTreeView, typenoeud)
On Error GoTo fin
'If Not IsNull(typenoeud) Then
If noeud.pere <> "0" Then
    tv.Nodes.Add "Ent" & noeud.pere, typenoeud, "Ent" & noeud.cle, noeud.nom
Else
    tv.Nodes.Add , , "Ent" & noeud.cle, noeud.nom
End If
fin:
End Sub
Sub EcrireProprietesNoeud(tv As TreeView, noeud As noeudPourTreeView)

End Sub
'Construire un 'noeud' à partir de la clé
Function ConstruireNoeudAvecCle(st As TablePereFilsStruct, cle As String) As noeudPourTreeView
Dim newnoeud As noeudPourTreeView
newnoeud.cle = cle
If cle > "0" Then
    newnoeud.pere = DLookup(st.nomclePere, st.nomtable, "[" & st.nomcle & "]=" & cle)
    newnoeud.nom = DLookup(st.nomTitreCourt, st.nomtable, "[" & st.nomcle & "]=" & cle)
End If

ConstruireNoeudAvecCle = newnoeud
End Function
'Renvoie le type du champs d'une table determinée (ou d'une requete)
Function GetTypeChamps(latable As String, lechamp As String)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset(latable)
GetTypeChamps = rst.Fields(lechamp).Type
rst.Close
End Function

Ajouter un commentaire



Nos sponsors

Sondage...

CalendriCode

Octobre 2008
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel BAÏSE, Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,016 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.