Discussion :

[clemasson]

Bonjour le forum,

j'ai récupéré un treeview dont le code est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub Charger()
  '    On Error GoTo Err_Charger
      Dim NodCurrent As Node
      Dim StrText As String
      Dim NodRoot As Node
      Dim Bk As String
      Set Db = CurrentDb
      Set Rs = Db.OpenRecordset("Menus", dbOpenDynaset, dbReadOnly)
      Set Menu = Me.Xtree.Object
      Menu.Nodes.Clear
      Rs.FindFirst "Menu_Parent Is Null Or Menu_Parent = 0"  ' Cherche le premier pere
      Do Until Rs.NoMatch
         StrText = Rs!Menu_Libelle
         Set NodCurrent = Menu.Nodes.Add(, , "a" & Rs!ID_Menu, StrText) ' Ajoute une branche père
         Bk = Rs.Bookmark     ' mémorise la place
         AddChildren NodCurrent, Rs   ' Lance une proc recursive pour trouver les fils
         Rs.Bookmark = Bk        ' Retourne à sa place
         Rs.FindNext "Menu_Parent Is Null Or Menu_Parent = 0"  ' suite de la recherche
      Loop
      Menu.Sorted = True
    Bulle "Sélectionnez votre formulaire ou votre état.", "cliquez sur :", "+ pour étendre", "- pour réduire"
Exit_Charger:
    Exit Sub
Err_Charger:
    Bulle "Chargement rubrique", "Erreur chargement", Rs("Menu_Libelle"), ""
    Resume Exit_Charger
End Sub
 
Sub AddChildren(nodBoss As Node, Rst As DAO.Recordset)
      On Error GoTo ErrAddChildren
      Dim NodCurrent As Node
      Dim objTree As TreeView, StrText As String, Bk As String
      Dim HeyBoss
      Set objTree = Me!Xtree.Object
      ' ** Cherche le premier fils, le No est dans la clé du boss
      Rst.FindFirst "Menu_Parent =" & Mid(nodBoss.Key, 2)
      Do Until Rst.NoMatch
         StrText = Rst("Menu_Libelle")
         ' Ajoute le premier fils
         Set NodCurrent = objTree.Nodes.Add(nodBoss, tvwChild, "a" & Rst("ID_Menu"), StrText)
         Bk = Rst.Bookmark
         ' on vérifie si ce fils est lui méme pére
         AddChildren NodCurrent, Rst
         Rst.Bookmark = Bk
         Rst.FindNext "Menu_Parent=" & Mid(nodBoss.Key, 2)
      Loop
ExitAddChildren:
         Exit Sub
ErrAddChildren:
        Bulle "Chargement rubrique", "Erreur chargement", "", ""
         Resume ExitAddChildren
      End Sub

Je souhaite adapter ce code à une autre table.

Mon problème c'est que je ne comprends pas pourquoi le code n'est pas compatible avec des champs au format texte (en ce qui concerne les clés Péres et fils). Il n'accepte que le type numérique.

En espérant que ce soit plus clair pour vous.

Merci.

[clemasson]

pour ceux que ça intéresse :

C'était dû à une erreur classique (gestion du texte # du numérique).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Charger1()
 
                    '''''''''''''''''''''''''''''
                   '  1ER Treeview : Equipement  '
                    '''''''''''''''''''''''''''''
 
      On Error GoTo Err_Charger1
      Dim NodCurrent1 As Node
      Dim StrText1 As String
      Dim NodRoot1 As Node
      Dim Bk1 As String
      Set Db = CurrentDb
      Set Rs1 = Db.OpenRecordset("Equipement", dbOpenDynaset, dbReadOnly)
      Set Menu1 = Me.Xtree1.Object
      Menu1.Nodes.Clear
      Dim strPere1 As String
      strPere1 = "EQP1NIV"
      Rs1.FindFirst "Menu_Parent = '" & strPere1 & "'" ' Cherche le premier pere
 
      Do Until Rs1.NoMatch
         StrText1 = Rs1!Menu_Libelle
         Set NodCurrent1 = Menu1.Nodes.Add(, , "a" & Rs1!ID_Menu, StrText1) ' Ajoute une branche père
         Bk1 = Rs1.Bookmark     ' mémorise la place
         AddChildren1 NodCurrent1, Rs1   ' Lance une proc recursive pour trouver les fils
         Rs1.Bookmark = Bk1        ' Retourne à sa place
         Rs1.FindNext "Menu_Parent = '" & strPere1 & "'"  ' suite de la recherche
      Loop
      Menu1.Sorted = True
Exit_Charger1:
        Exit Sub
Err_Charger1:
    Resume Exit_Charger1
 
End Sub