Type Xmlelement
id As String
label As String
indent As Long
parentId As String
TagName As String
vu As Boolean
End Type
Public AllElements() As Xmlelement
Dim element As Xmlelement
Sub init()
ReDim Preserve AllElements(0 To 0)
End Sub
Function Appendchild(parent As Xmlelement, enfant As Xmlelement) 'attribut d'affiliation
enfant.parentId = parent.id
End Function
Function createElement(TagName) As Xmlelement 'creation d'un element(tout type argument "Tagname" pour le type )
Dim elem As Xmlelement
elem.TagName = TagName
ReDim Preserve AllElements(UBound(AllElements) + 1): AllElements(UBound(AllElements)) = elem: createElement = AllElements(UBound(AllElements))
End Function
Function GetelementById(idx As String) As Xmlelement 'fonction pour rechercher un element portant un id précis(utile pour plus tard quand on construire dynamico
For i = 1 To UBound(AllElements)
If AllElements(i).id = idx Then GetelementById = AllElements(i): Exit Function
Next
End Function
Function getValidId(TagName) ' fonction pour determiner un id valide et non utilisé(variante de mon creator adapté pour la circonstance)
Dim e&, x As Boolean, i&
For e = 1 To 1000
vid = TagName & "_" & e
x = False
For i = 0 To UBound(AllElements)
If AllElements(i).id = vid Then x = True: Exit For
Next
If x = False Then getValidId = vid: Exit For
Next
End Function
Sub test()
init
Dim ParentX As Xmlelement
'creation du père de tous ( le patron)
element = createElement("père")
With element
.id = getValidId(.TagName)
.indent = 0
.label = "Robert"
ParentX = GetelementById("") 'le père n'a pas de parent
Appendchild ParentX, element
.indent = ParentX.indent + 1
AllElements(UBound(AllElements)) = element
End With
'maintenant je vais créer le fils
element = createElement("fils")
With element
.id = getValidId(.TagName)
.label = "jean"
ParentX = GetelementById("père_1") 'je choisi le parent a qui je veux l'affilier
Appendchild ParentX, element
.indent = ParentX.indent + 1
AllElements(UBound(AllElements)) = element
End With
'maintenant je vais créer le fils2
element = createElement("fils")
With element
.id = getValidId(.TagName)
.label = "Luc"
ParentX = GetelementById("père_1") 'je choisi le parent a qui je veux l'affilier
Appendchild ParentX, element
.indent = ParentX.indent + 1
AllElements(UBound(AllElements)) = element
End With
'maintenant pour l'exemple je vais créer le petit fils qui sera le fils du fils 1
'creation du petit fils
element = createElement("petitfils")
With element
.id = getValidId(.TagName)
.label = "kevin"
ParentX = GetelementById("fils_1") 'je choisi le parent a qui je veux l'affilier
.indent = ParentX.indent + 1
Appendchild ParentX, element
AllElements(UBound(AllElements)) = element
End With
'la voiture du du fils 1
'creation du petit fils
element = createElement("voiture")
With element
.id = getValidId(.TagName)
.label = "Renault"
ParentX = GetelementById("fils_1") ' je choisi a qui est la voiture
.indent = ParentX.indent + 1
Appendchild ParentX, element
AllElements(UBound(AllElements)) = element
End With
lecture
End Sub
Sub lecture()
For i = 1 To UBound(AllElements)
Dim e As Xmlelement
e = AllElements(i)
Debug.Print "<" & e.TagName & " id=""" & e.id & """" & " label=""" & e.label & """" & _
" parentID=""" & e.parentId & """" & " indent=""" & e.indent & """"
Next
Debug.Print "***************************************"
GenerateCodXmL
End Sub
Function GenerateCodXmL(Optional i As Long = 0)
Dim e As Xmlelement, a&
Static codeXml As String
e = AllElements(i)
If i = 0 Then PartCod = "": codeXml = ""
If Not e.vu Then
If " voiture " Like "* " & e.TagName & " *" Then fin = "/>" Else fin = ">"
PartCod = String(e.indent, vbTab) & "<" & e.TagName
PartCod = PartCod & " id = """ & e.id & """"""
If e.label <> "" Then PartCod = PartCod & " label=""" & e.label & """" & fin
PartCod = PartCod & fin
'codeXml = codeXml & PartCod & vbCrLf
Debug.Print PartCod
With AllElements(i): .vu = True: End With
End If
For a = i + 1 To UBound(AllElements)
If AllElements(a).vu = False Then
If AllElements(a).parentId = e.id Then
GenerateCodXmL a
End If
End If
Next
If " père " Like "* " & e.TagName & " *" Then
Debug.Print String(e.indent, vbTab) & "</" & e.TagName & ">"
'codeXml = codeXml & String(e.indent, vbTab) & "</" & e.TagName & ">" & vbCrLf
End If
If i = 0 And codeXml <> "" Then Debug.Print codeXml
GenerateCodXmL = codeXml
End Function