Structure en Arbre n-aire en VBA

Dim mondico
Sub essai()
  Set mondico = CreateObject("scripting.dictionary")
  ajout "bb,aa"
  ajout "cc,aa"
  ajout "dd,aa"
  ajout "ee,bb"
  ajout "ff,bb"
  ajout "gg,dd"
  ajout "hh,ee"
  ajout "ii,ee"
  ajout "jj,hh"
  ajout "kk,hh"
  MsgBox affiche()
  SupPère "bb"
  MsgBox affiche()
End Sub

Sub SupPère(père)
   vpersonnes père, 1
End Sub

Sub ajout(FilsPère)
  a = Split(FilsPère, ",")
  clé = a(0): élem = a(1)
  mondico(clé) = élem
End Sub

Function affiche()
  tmp = ""
  For Each c In mondico.keys
   If mondico(c) <> "" Then tmp = tmp & "Fils:" & c & " - père:" & mondico.Item(c) & vbLf
  Next c
  affiche = tmp
End Function

Sub vpersonnes(parent, niv)       ' procédure récursive
  For Each c In mondico.keys
    If mondico.Item(c) = parent Then vpersonnes c, niv + 1
  Next c
  mondico.Remove parent
End Sub

Private Tbl(1 To 100, 1 To 3)
Private n, branche
Public Property Let ajout(FilsPère)
  a = Split(FilsPère, ",")
  clé = a(0): élem = a(1)
  n = n + 1
  Tbl(n, 1) = clé: Tbl(n, 2) = élem
End Property

Public Property Let SupBranche(père)
   SupItem père, 1
    For i = n To 1 Step -1
     If Tbl(i, 3) = "sup" Then
        For k = i To n
           Tbl(k, 1) = Tbl(k + 1, 1)
           Tbl(k, 2) = Tbl(k + 1, 2)
           Tbl(k, 3) = Tbl(k + 1, 3)
        Next k
        n = n - 1
     End If
   Next i
End Property

Public Property Get VisuBranche(père)
   visu père, 1
   VisuBranche = branche
End Property

Public Property Get affiche()
  tmp = ""
  For p = 1 To n
   If Tbl(p, 1) <> "" Then tmp = tmp & "Fils:" & Tbl(p, 1) & " - père:" & Tbl(p, 2) & vbLf
  Next p
  affiche = tmp
End Property

Public Property Get père(fils)
   For i = 1 To n
     If Tbl(i, 1) = fils Then père = Tbl(i, 2)
   Next i
End Property

Public Property Get taille()
  taille = n
End Property

Sub SupItem(parent, niv)       ' procédure récursive
  For i = 1 To n
    If Tbl(i, 2) = parent Then SupItem Tbl(i, 1), niv + 1
  Next i
  For k = 1 To n
   If Tbl(k, 1) = parent Then Tbl(k, 3) = "sup"
  Next k
End Sub

Sub visu(parent, niv) ' procédure récursive
  branche = branche & parent & vbLf
  For i = 1 To n
    If Tbl(i, 2) = parent Then visu Tbl(i, 1), niv + 1
  Next i
End Sub

Sub AjoutArbreAunAutre()
   Set a = New Arbre
   Set b = New Arbre
   '--- arbre a
   Set f = Sheets("bd")
   For i = 2 To f.[A65000].End(xlUp).Row
     a.ajout = f.Cells(i, 1) & "," & f.Cells(i, 2)
   Next i
   '--- arbre b
   b.ajout = "nn,mm"
   b.ajout = "oo,mm"
   b.ajout = "pp,nn"
   b.ajout = "qq,pp"
   '--- on ajoute arbre b à la branche ee de l'arbre a
   aa = Split(b.liste(), ":")
   bb = Split(aa(0), ",")
   a.ajout = bb(1) & ",ee"    ' on raccroche la branche mm  de b à ee de a
   For i = LBound(aa) To UBound(aa)
     a.ajout = aa(i)
   Next i
   a.DessineBrancheShapes = "aa,feuil3"
   Sheets("feuil3").Select
End Sub

Class A
      private maString1 as String
      private mesAbonnes as collection

      public Sub AjouterAbonne(unObjet as Object)
              mesAbonnes.add unObjet
      end sub

      public property LET String1 (s as string)
               maString1 = s
               Dim o as object
               for each o in mesAbonnes
                    o.[B][I]traitementAFaire[/I][/B] 'traitementAFaire DOIT ETRE une méthode commune à tous les objets de la collection, même s'ils ne sont pas du même type
               next o
      end property
end class

Class B
       public sub Init (unA as A)
             ...traitements divers
             ...traitements divers
             unA.AjouterAbonne B
       end sub

       public sub traitementAFaire()
             ...
             ...
      end sub
end class

Class C
       public sub Init (unA as A)
             ...traitements divers
             ...traitements divers
             unA.AjouterAbonne C
       end sub

       public sub traitementAFaire()
             ...
             ...
      end sub
end class