Option Explicit

Dim objDOM As DOMDocument
 
 
Sub Creation_interface()
    'Définit la plage de cellules qui va servir pour la création du fichier xml
    CreationFichierXML Worksheets("Interface_Export").Range("A:AH")
End Sub
 
 
Sub CreationFichierXML(Plage As Range)

Dim XnodeRoot As IXMLDOMElement, oNode As IXMLDOMNode
Dim XNom1 As IXMLDOMElement
Dim XNom2 As IXMLDOMElement
Dim XNom3 As IXMLDOMElement
Dim XNom4 As IXMLDOMElement
Dim XNom5 As IXMLDOMElement
Dim XNom6 As IXMLDOMElement
Dim Cmt As IXMLDOMComment
Dim Entete As Range, Cell As Range
Dim i As Integer, j As Integer
Dim w1 As Worksheet
 
Set Entete = Plage.Rows(1)
Set w1 = Sheets("Interface_Export")
Set Plage = w1.Range("A" & Rows.Count).End(xlUp)
 
Set objDOM = New DOMDocument

'Ajoute un commentaire qui reprend le nom de l'utilisateur et la date du jour.
Set Cmt = objDOM.createComment("Créé par " & Environ("username") & ", le " & Date)
Set Cmt = objDOM.InsertBefore(Cmt, objDOM.ChildNodes.Item(0))
 
   
'Type de fichier et version xml
Set oNode = objDOM.createProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
Set oNode = objDOM.InsertBefore(oNode, objDOM.ChildNodes.Item(0))
    
Set XnodeRoot = objDOM.createElement("INTERFACE")
objDOM.appendChild XnodeRoot 'ici on définit la balise racine du fichier xml

'Boucle sur les données du tableau
For i = 1 To Plage.Rows.Count ' ici on récupère les données lignes
    Set XNom1 = objDOM.createElement("DESCRIPTION")
    XnodeRoot.appendChild XNom1 'ici on indique où le noeud est le fils et le parent Parent.appendchild fils
        
    For j = 1 To 3 'ici on détermine les colonnes que l'on souhaite rattacher
        CreationElement Entete.Cells(1, j), Plage.Cells(i, j), XNom1
    Next j

    Set XNom2 = objDOM.createElement("CONTENU")
    XnodeRoot.appendChild XNom2
    
    Set XNom3 = objDOM.createElement("ENT_DOS")
    XNom2.appendChild XNom3 'ici on indique où le noeud est le fils et le parent Parent.appendchild fils
    
    For j = 4 To 20
        CreationElement Entete.Cells(1, j), Plage.Cells(i, j), XNom3
     Next j

    Set XNom4 = objDOM.createElement("DEST")
    XNom2.appendChild XNom4 'ici on indique où le noeud est le fils et le parent Parent.appendchild fils
    
    For j = 21 To 26
        CreationElement Entete.Cells(1, j), Plage.Cells(i, j), XNom4
     Next j
     
    Set XNom5 = objDOM.createElement("EXP")
    XNom2.appendChild XNom5 'ici on indique où le noeud est le fils et le parent Parent.appendchild fils
    
    For j = 27 To 32
        CreationElement Entete.Cells(1, j), Plage.Cells(i, j), XNom5
     Next j
     
    Set XNom6 = objDOM.createElement("LIGNE")
    XNom2.appendChild XNom6 'ici on indique où le noeud est le fils et le parent Parent.appendchild fils
    
    For j = 33 To 41
        CreationElement Entete.Cells(1, j), Plage.Cells(i, j), XNom6
     Next j

Next i


objDOM.Save "C:\Users\user\Desktop\création interface\Interface" & "_" & Range("D2") & "_" & Range("E2") & ".xml"

Set XnodeRoot = Nothing
Set objDOM = Nothing
End Sub
 

Sub CreationElement(strElem As String, Donnee As Variant, oNom As IXMLDOMElement)
    Dim XInfos As IXMLDOMNode
    Set XInfos = objDOM.createElement(strElem)
    XInfos.Text = Donnee
    oNom.appendChild XInfos
End Sub