XL 2013 petit problème dans une remontée récursive dans les instances de classe en poupée russe

[patricktoulon]

bonjour a tous
bien que j'y arrive très bien sans module classe
pour le fun je m'essaie a imiter le fonctionnement d'un object domdocument avec une classe
pour cela j'ai un module classe assez simple
dans cette classe une variable tableau "childs"
a chaque instance dans cette variable tableau je lui met l'instance suivante(classe en poupée russe)
a la fin je teste le childx(x).propriété d'une instance et çà fonctionne

par contre quand j'essaie de partir de la première (docXML) et que je liste en récursif pour chopper tout les childs avec la fonction getElementById là ça ne va plus

des idées

 

[Dranreb]

Bonjour.
Il vaudrait mieux que childs soit typé As Collection.
En fait ça ressemble beaucoup à ma classe SsGr :

Option Explicit
Public Id As Variant, Co As Collection
Public Sub Add(ByVal QuelqueChose)
   Co.Add QuelqueChose
   End Sub
Public Function Count() As Long
   Count = Co.Count
   End Function
Public Function Nombre() As Long
   Dim Mmbr As SsGr
   If TypeOf Co(1) Is SsGr Then
      For Each Mmbr In Co: Nombre = Nombre + Mmbr.Nombre: Next Mmbr
   Else: Nombre = Co.Count: End If
   End Function
Public Function NbType(ByVal C As Long, ByVal VType As VbVarType) As Long
   Dim Mmbr As SsGr, Détail
   If TypeOf Co(1) Is SsGr Then
      For Each Mmbr In Co: NbType = NbType + Mmbr.NbType(C, VType): Next Mmbr
   Else
      For Each Détail In Co: NbType = NbType - (VarType(Mmbr(C)) = VType)
         Next Détail: End If
   End Function
Public Function Somme(ByVal C As Long) As Double
   Dim Mmbr As SsGr, Détail
   If TypeOf Co(1) Is SsGr Then
      For Each Mmbr In Co: Somme = Somme + Mmbr.Somme(C): Next Mmbr
   Else: On Error Resume Next
      For Each Détail In Co: Somme = Somme + Détail(C)
         Next Détail: End If
   End Function
Public Function Total(ByVal C As Long) As Currency
   Dim Mmbr As SsGr, Détail
   If TypeOf Co(1) Is SsGr Then
      For Each Mmbr In Co: Total = Total + Mmbr.Total(C): Next Mmbr
   Else: On Error Resume Next
      For Each Détail In Co: Total = Total + Détail(C)
         Next Détail: End If
   End Function
Public Function NbSi(ByVal CR As Long, ByVal V) As Long
   Dim Mmbr As SsGr, Détail
   If TypeOf Co(1) Is SsGr Then
      For Each Mmbr In Co: NbSi = NbSi + Mmbr.NbSi(CR, V): Next Mmbr
   Else: On Error Resume Next
      For Each Détail In Co: If Détail(CR) = V Then NbSi = NbSi + 1
         Next Détail: End If
   End Function
Public Function SommeSi(ByVal CR As Long, ByVal V, ByVal CS As Long) As Double
   Dim Mmbr As SsGr, Détail
   If TypeOf Co(1) Is SsGr Then
      For Each Mmbr In Co: SommeSi = SommeSi + Mmbr.SommeSi(CR, V, CS): Next Mmbr
   Else: On Error Resume Next
      For Each Détail In Co: If Détail(CR) = V Then SommeSi = SommeSi + Détail(CS)
         Next Détail: End If
   End Function
Public Function DonnéesDébut() As Variant()
   If TypeOf Co(1) Is SsGr Then DonnéesDébut = Co(1).DonnéesDébut Else DonnéesDébut = Co(1)
   End Function
Public Function DonnéesFin() As Variant()
   If TypeOf Co(1) Is SsGr Then DonnéesFin = Co(Co.Count).DonnéesFin Else DonnéesFin = Co(Co.Count)
   End Function
Public Sub Extraire(T(), ByVal C As Long)
   Dim Mmbr As SsGr, Détail, TD(), N As Long, V
   ReDim T(1 To Nombre)
   If TypeOf Co(1) Is SsGr Then
      For Each Mmbr In Co: Mmbr.Extraire TD, C
         For Each V In TD: N = N + 1: T(N) = V: Next V, Mmbr
   Else
      For Each Détail In Co: N = N + 1: T(N) = Détail(C): Next Détail: End If
   End Sub
Public Function ItemSsGr(ByVal Clé As String) As SsGr
   On Error Resume Next
   Set ItemSsGr = Co.Item(Clé)
   End Function

 

[patricktoulon]

Bonjour @Dranreb
j' avoue je ne vois pas très bien comment addapter une collection childs(donc collection de xmlelement)
sachant que
la création se fait par l'instance de la classe(docXML)
le appendchild se fait par l'instance parent ou l'on veut placer le fils
je viens de tester j'ai une erreur

propriété ou méthode non géré par l'object

le module classe

Option Explicit
Public tagName As String
Public id As String
Public label As String
Public childs As Collection
Public childcount As Long
Public parentX


Public Function createElement(tagName)
    Dim Q As New XmlElement
    'Set Q = New XmlElement
    Q.tagName = tagName
    Set createElement = Q

End Function

Public Function AppendChild(e As XmlElement)
   Me.childs.Add e
End Function

le module standard

Option Explicit
Public DocXML As XmlElement
Dim CustomUI, ribbon, tabs, XtaB, group, button
Sub test()
    Dim elem As XmlElement
    Set DocXML = New XmlElement


    Set CustomUI = DocXML.createElement("customUI")
    DocXML.AppendChild (CustomUI)

    Set ribbon = DocXML.createElement("ribbon")
    CustomUI.AppendChild (ribbon)

    Set tabs = DocXML.createElement("tabs")
    ribbon.AppendChild (tabs)

    Set XtaB = DocXML.createElement("tab")
    XtaB.id = "tab_" & tabs.childcount + 1
    XtaB.label = "mon onglet"
    tabs.AppendChild (XtaB)


    Set group = DocXML.createElement("group")
    group.id = "group_" & XtaB.childcount + 1
    group.label = "mon onglet"
    XtaB.AppendChild (group)


    Set button = DocXML.createElement("group")
    button.id = "button_" & group.childcount + 1
    button.label = "mon bouton"
    group.AppendChild (button)

    Set button = DocXML.createElement("group")
    button.id = "button_" & group.childcount + 1
    button.label = "mon bouton 2"
    group.AppendChild (button)


  
End Sub

 

[Dranreb]

Il vaut mieux typer explicitement les variables globales et transmettre ByVal la plupart des paramètres.
Je prévoirait une méthode Add pour ajouter un élément et une méthode Init pour initialiser ses propriétés en écriture. Je fais toujours comme ça.

 

[dysorthographie]

Bonjour Patrick,
je n'es pas vraiment compris ce que tu cherchais ,mais en fonction de ton code voila ce que j'ai pondu!

la classe XmlElement

Option Explicit
Public tExiste As String
Public Tag As String
Public ID As String
Public label As String
Public childs As New Collection
Public childcount As Long
Public parentX As XmlElement

Public Property Get Existe(t As String) As Boolean
Existe = InStr(1, "©" & tExiste & "©", "©" & t & "©")
End Property

Public Sub createElement(tagName As String)
If Not Existe(tagName) Then
    childs.Add New XmlElement, tagName
    Set childs(tagName).parentX = Me
    tExiste = tExiste & "©" & tagName & "©"
 
End If
    childs(tagName).Tag = tagName
End Sub

Public Sub AppendChild(tagName As String, ID As String, label As String)
If Existe(tagName) Then
    If Not childs(tagName).Existe(tagName & "_" & childs(tagName).childs.Count + 1) Then
        childs(tagName).childs.Add New XmlElement, tagName & "_" & childs(tagName).childs.Count + 1
        childs(tagName).tExiste = childs(tagName).tExiste & "©" & tagName & "_" & childs(tagName).childs.Count & "©"
    End If
     childs(tagName).childs(tagName & "_" & childs(tagName).childs.Count).ID = ID & childs(tagName).childs.Count
     childs(tagName).childs(tagName & "_" & childs(tagName).childs.Count).label = label
     childs(tagName).childs(tagName & "_" & childs(tagName).childs.Count).Tag = tagName & "_" & childs(tagName).childs.Count
    Set childs(tagName).childs(tagName & "_" & childs(tagName).childs.Count).parentX = childs(tagName)
End If

'   Dim x
'   x = UBound(childs) + 1
'    ReDim Preserve childs(1 To x) As New XmlElement
'    Set childs(x) = e
'    Set childs(x).parentX = Me
'    childcount = x
End Sub

'Public Function ChildNodes(Optional x As Long = -1) 'As XmlElement
'    If x > -1 Then
'        Set ChildNodes = childs(x)
'    Else
'        ChildNodes = childs
'    End If
'End Function

Public Function getElementById(Optional tagName As String = "", Optional child As String = "") As XmlElement
Dim Obj As XmlElement, Ob As XmlElement
    If tagName = "" Or Not Existe(tagName) Then
        Set getElementById = Me
    Else
 
        If child = "" Or Not childs(tagName).Existe(child) Then Set getElementById = Me.childs(tagName) Else Set getElementById = Me.childs(tagName).childs(child)
    End If
'   On Error Resume Next
'    Debug.Print "|" & Obj.Tag
'   For Each Ob In Obj.childs
'        MsgBox Ob.ID
'       Ob.getElementById Ob.Tag
'    Next
'    Set getElementById = Nothing
End Function

le Module1

Option Explicit
Public DocXML
Dim CustomUI, ribbon, tabs, XtaB, group, button
Sub test()
    Dim elem As XmlElement, elem2 As XmlElement, elem3 As XmlElement
    Set DocXML = New XmlElement


'    Set CustomUI =
    DocXML.createElement ("customUI")
'    DocXML.AppendChild (CustomUI)

     DocXML.createElement ("ribbon")
'    CustomUI.AppendChild (ribbon)

   DocXML.createElement ("tabs")
'    ribbon.AppendChild (tabs)

 DocXML.createElement ("tab")
'    XtaB.id = "tab_" & tabs.childcount + 1
'    XtaB.label = "mon onglet"
    DocXML.AppendChild "tab", "tab_", "mon onglet"


     DocXML.createElement ("group")
'    group.id = "group_" & XtaB.childcount + 1
'    group.label = "mon onglet"
    DocXML.AppendChild "group", "group_", "mon onglet"


'    Set button = DocXML.createElement("group")
'    button.id = "button_" & group.childcount + 1
'    button.label = "mon bouton"
    DocXML.AppendChild "group", "button_", "mon bouton"

'    Set button = DocXML.createElement("group")
'    button.ID = "button_" & group.childcount + 1
'    button.label = "mon bouton 2"
'    group.AppendChild (button)

DocXML.AppendChild "group", "button_", "mon bouton 2"

    Set elem = DocXML.getElementById
    MsgBox elem.ID
    If Not (elem.parentX Is Nothing) Then MsgBox elem.parentX.ID
 
 
     Set elem2 = DocXML.getElementById("group")
     MsgBox elem2.ID
    If Not (elem2.parentX Is Nothing) Then MsgBox elem2.parentX.ID

   Set elem3 = DocXML.getElementById("group", "group_1")
    MsgBox elem3.ID
    If Not (elem3.parentX Is Nothing) Then MsgBox elem3.parentX.ID
    For Each elem In DocXML.childs
        For Each elem2 In elem.childs
            Debug.Print elem.Tag, elem2.Tag, elem2.ID, elem2.label
        Next

    Next

        For Each elem2 In DocXML.getElementById("group").childs
            Debug.Print elem.Tag, elem2.Tag, elem2.ID, elem2.label
        Next

End Sub

 

[patricktoulon]

re
@Dranreb oui je sais mais des que le le fait ca fonctionne plus du tout
ca n'accepte que le variant dans certains cas

@dyhortographie
bonjour Robert content de te revoir
les msgbox en résultat ne donnent pas ce qui est prévu

 

[Dranreb]

en ByRef ça n'accepte qu'un argument rigoureusement du type indiqué. En ByVal ça peut aussi accepter un variant contenant une valeur du type indiqué, une expresson convertible en celui ci etc.

 

[dysorthographie]

Normal tu n'affecte les id qu'aux enfants et c'est l'id que des parents que tu cherches à afficher ???

C'est une des raisons qui m'ont fait dire que je n'es pas bien compris ce que tu cherchais

 

[Dranreb]

Exemple :

Option Explicit
Public Name As String
Public Index As Long
Public Label As String
Public Childs As Collection
Public Parent As XmlElement
Public Sub Init(ByVal Owner As XmlElement, ByVal Name As String, ByVal Label As String)
   Me.Name = Name
   Me.Index = Owner.Count + 1
   Me.Label = Label
   Set Childs = New Collection
   Set Parent = Owner
   End Sub
Public Function Add(ByVal Name As String, ByVal Label As String) As XmlElement
   Set Add = New XmlElement
   Add.Init Me, Name, Label
   Childs.Add Item:=Add, Key:=Name
   End Function
Public Function Count()
   Count = Childs.Count
   End Function
Public Function Item(ByVal CléOuIndex) As XmlElement
   On Error Resume Next
   Set Item = Childs(CléOuIndex)
   End Function

 

[dysorthographie]

Public Sub Add(ByVal Name As String, ByVal Label As String
   Childs.Add Item:=New XmlElement Key:=Name
     With Childs(Name)
         .Init Me, Name, Label
          .Index = Childs.Count
    End with
End Sub

@Dranreb comme tu gères dans ta collection le fait que Patrick utilise plusieurs fois la clé "group"

 

[patricktoulon]

en fait ma base fonctionne mais c'est la fonction récursive qui me renvoie une erreur
et pour le type byval ou byref rien y fait
la base avec des msgbox de test
j'ai bloqué les declarations typée
debloquez les vous verrez

MODULE STANDARD

Option Explicit
Public DocXML

'Dim CustomUI As XmlElement, ribbon As XmlElement, tabs As XmlElement, XtaB As XmlElement
'Dim group As XmlElement, button As XmlElement

' SI DEBLOQUE LES DeCLARATIONS CI DESSUS CA PLANTE
' en variant ci DESSOUS ca fonctionne
Dim CustomUI, ribbon, tabs, XtaB
Dim group, button

Public allElements() As XmlElement

Sub test()
    Dim elem As XmlElement, i&
    ReDim Preserve allElements(0 To 0)
    Set DocXML = New XmlElement


    Set CustomUI = DocXML.createElement("customUI")
    DocXML.AppendChild (CustomUI)

    Set ribbon = DocXML.createElement("ribbon")
    CustomUI.AppendChild (ribbon)

    Set tabs = DocXML.createElement("tabs")
    ribbon.AppendChild (tabs)

    Set XtaB = DocXML.createElement("tab")
    XtaB.id = "tab_" & tabs.childcount + 1
    XtaB.label = "mon onglet"
    tabs.AppendChild (XtaB)


    Set group = DocXML.createElement("group")
    group.id = "group_" & XtaB.childcount + 1
    group.label = "mon group"
    XtaB.AppendChild (group)


    Set button = DocXML.createElement("button")
    button.id = "button_" & group.childcount + 1
    button.label = "mon bouton"
    group.AppendChild (button)

    Set button = DocXML.createElement("button")
    button.id = "button_" & group.childcount + 1
    button.label = "mon bouton 2"
    group.AppendChild (button)


MsgBox tabs.parentX.tagName 'le tagname du parent du tabs  ---->OK
MsgBox button.parentX.id 'le id du parent du bouton  ---->OK
MsgBox group.ChildNodes(2).id 'le id du 2d enfant du groupe  ---->OK


'pourquoi donc une fonction recursive ne fonctionne pas
'puisque c'est récursif on demarre de l'element docxml(soit me dans le module classe
DocXML.getElementById DocXML, "tab_1"
    
    'POUR VOIR SI LES ELEMENTS EXISTENT BIEN J AI INSTRUIT A CHAQUE APPENDcHILD UNE VARIABLE TABLEAU D XMLELEMENT
    ' CETTE VARIABLE EST PUBLIC DANS LE MODULE STANDARD
    For i = 1 To UBound(allElements)
    Debug.Print allElements(i).tagName & vbTab & allElements(i).id & vbTab & allElements(i).label
    Next
    
  
End Sub

MODULE CLASSE

Option Explicit
Public tagName As String
Public id As String
Public label As String
Public childs
Public childcount As Long
Public parentX
Private Sub Class_Initialize()
    ReDim childs(0 To 0) As XmlElement
End Sub

Public Function createElement(tagName) As XmlElement
    Dim Q As XmlElement
    Set Q = New XmlElement
    Q.tagName = tagName
    Set createElement = Q
End Function

Public Function AppendChild(ByVal e As XmlElement)
    Dim x&, z&
    x = UBound(childs) + 1
    ReDim Preserve childs(1 To x) As New XmlElement
    Set childs(x) = e
    Set childs(x).parentX = Me
    childcount = x
    
    'stockage des element dans la variable public du module standard
    z = UBound(allElements) + 1
    ReDim Preserve allElements(0 To z)
    Set allElements(z) = e
End Function

Public Function ChildNodes(Optional x As Long = -1)    'As XmlElement
    If x > -1 Then
        Set ChildNodes = childs(x)
    Else
        ChildNodes = childs
    End If
End Function

Public Function getElementById(Optional element As XmlElement = Nothing, Optional idx As String = "") As XmlElement
    If element Is Nothing Then Set element = Me
    On Error Resume Next
    Debug.Print "|" & element.tagName
    For i = 1 To element.childcount
        MsgBox element.childs(i).id
        getElementById element.childs(i), idx
    Next
    Set getElementById = Nothing
End Function

Perso c'est la fonction getelementbyid qui me pose soucis
normalement
si je la lance avec le 1er
il me le debug et la boucle rappelle la fonction avec ses enfants(qui ont comme parendId le id
et ainsi de suite non ?
alors entre ça et les variable qui doivent resté variant je sa""is plus moi

robert tu peux me faire un exemple plus simple avec 2 elements l'un enfant de l'autre

 

[Dranreb]

Regarde ma structure du #9. Ça devrait être plus simple de créer l'objet en l'ajoutant que de le faire en deux méthodes.
Remarque: s'il ne sera jamais nécessaire de retrouver un élément par son nom, on peut se passer de la propriété Name. Par contre il pourrait être intéressant d'avoir une propriété Type.
Je suis comme @dysorthographie, je ne sais pas à quoi ça va servir tout ça.

 

[Dranreb]

Aucun problème pour construire ni remonter l'arboresscence

 

[patricktoulon]

re
je garde ta remarque @Dranreb j'ai fini par trouver ce qui clochait
alors oui en effet les variable doivent rester variant je ne sais pas pourquoi partout aleurs ou on est sensé les recevoir en arguments et bien les argument sont en "XmlElement"
après aussi bizarre soit il c'est le docxml qui doit pas être variant
ensuite la fonction getElementById maintenant fonction et me scrute les element non pas dans l'ordre de creation mais bel et bien dans l'ordre hierarchique
du coup je garderais ce model pour faire la fonction generateXML

 

[patricktoulon]

je regarde ton fichier