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

 

[dysorthographie]

Module1

Option Explicit
Public DocXML
Dim CustomUI As XmlElement, ribbon As XmlElement, tabs As XmlElement, XtaB As XmlElement, group As XmlElement, button As XmlElement
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, "tab_" & tabs.childcount + 1, "mon onglet"
    


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


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

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


    Set elem = group.ChildNodes(1)
    MsgBox elem.ID
    MsgBox elem.parentX.ID

Dim D As XmlElement
   Set D = DocXML.getElementById(Cherche:="tab_1")
     MsgBox D.ID
    MsgBox D.parentX.ID
End Sub

XmlElement

Option Explicit
Public tagName As String
Public ID As String
Public label As String
Public childs As Collection, trouve As XmlElement
Public childcount As Long
Public parentX
Private Sub Class_Initialize()
  Set childs = New Collection
 End Sub

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

Public Function AppendChild(E As XmlElement, Optional ID As String = "", Optional label As String = "")
     childs.Add E
     Set childs(childs.Count).parentX = Me
     childcount = childs.Count
     childs(childcount).ID = ID
    childs(childcount).label = label
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 = "", Optional Cherche As String = "") As XmlElement
Dim i As Integer
   If element Is Nothing Then Set element = Me
  
   On Error Resume Next
    Debug.Print "|" & element.tagName
    If Cherche = element.ID Then Set trouve = element: Set parentX.trouve = element: Exit Function

    For i = 1 To element.childcount
        MsgBox element.childs(i).ID
       trouve = getElementById(element.childs(i), idx, Cherche)
       If Not (trouve Is Nothing) Then Set getElementById = trouve: Set parentX.trouve = element: Exit Function
    Next
    

 
End Function

 

[patricktoulon]

re
merci robert j'avais trouvé
je vais tester ton fichier
@Dranreb essaie de construire comme tu fait mais ajoute un 2d group avant le bouton et ajoute un bouton dans chaque groupe après
le but c'est ça en fait ,c'est de pouvoir revenir sur un parent et lui ajouter des enfants ou en supprimer ou les modifier
et sans sans récursif c'est mort

 

[Dranreb]

Ben il y a ma propriété Parent pour ça comme tu peux voir
On pourrait ajouter une méthode Delete au XmlElement pour le supprimer de son parent, mais attention il faudrait décrémenter tous les Index des éléments qui le suivaient pour conserver l'accès positionnel possible.

 

[patricktoulon]

re
bon je regarderais tout a l'heure
tu m'aurais coder ça autrement sans with imbriqué j'aurais peut être compris
les with Add et with .Add j'ai perdu un oeil là

 

[patricktoulon]

c'est @RyuAutodidacte qui va être content
on a 3 méthodes qui fonctionnent et je suis parti défaitiste en plus comme quoi hein
je pense qu'il va apprécier un Ma x Cimum

 

[patricktoulon]

robert oui c'est ça

 

[patricktoulon]

@Dranreb , @dyhortographie

c'est ce qui s'appelle aller au bout de l'intention

 

[patricktoulon]

Bonjour à tous
@Dranreb
@dysorthographie
@RyuAutodidacte

j'aurais une dernière question
j'instancie ma première classe avec "DocXML"
toute les autre sont l'une dans l autre ect
dans les instances autre que DocXML je voudrais charger un tableau( de docXML) avec les ids simplement (du string)

j'ai une erreur object ou méthode introuvable

Public Function AppendChild(ByVal e As XmlElement)
' avant d 'aller plus loin
'test de possibilité selon les règles de bases du xml schemas microsoft customUI
    Select Case e.tagName
    Case "button"
        If Not " group box menu buttonGroup dropDown " Like "* " & Me.tagName & " *" Then
            MsgBox " vous ne pouvez pas mette un " & e.tagName & " dans un " & Me.tagName: Set e = Nothing
            Exit Function
        End If
    Case "group"
        If Me.tagName <> "tab" Then MsgBox " vous ne pouvez pas mette un " & e.tagName & " dans un " & Me.tagName: Set e = Nothing: Exit Function

        'etc..etc..

    End Select


    Dim x&, z&
    x = UBound(childs) + 1
    ReDim Preserve childs(1 To x) As New XmlElement
    e.indent = Me.indent + 1
    Set childs(x) = e
    Set childs(x).parentX = Me
    childcount = x
    '******************************************************
    'l 'erreur se passe ici !!!
    'stockage des element dans la variable public allElements (mais celle de l'instance de docXML)
    ' MsgBox UBound(DocXML.AllElements)
    'z = UBound(DocXML.AllElements) + 1
    ' ReDim Preserve DocXML.AllElements(0 To z)
    'Set DocXML.AllElements(z) = e.id
    '******************************************************
End Function

je joins le fichier

 

[patricktoulon]

re
bon ben c'est bon j'ai encore trouvé tout seul je le charge au createelement même si les property ne sont pas encore mises un object c'est un object je le récupère plus tard avec les property