macro excel to Xml

azzouzze

XLDnaute Junior
j ai un fichier excel qui est formé de la facon suivant:

col A col B col C
<balise1> blablabla </balise1>
<balise2> blablabla </balise2>

Je cherche une macro qui puisse prendre chaque cellule de la ligne 1 à la ligne N et l'ecrire dans un fichier .txt qui me servira au final d'xml dans un autre soft.



Merci de votre aide
 

MichelXld

XLDnaute Barbatruc
Re : macro excel to Xml

bonsoir


un exemple pour créer un fichier xml à partir des données d'une plage de cellules :


Code:
Option Explicit
Dim objDOM As DOMDocument

Sub Test()
    'Définit la plage de cellules qui va servir pour la création du
    'fichier xml.
    'La première ligne du tableau est supposée contenir les entêtes
    '(sans espaces ni caractères spéciaux).
    CreationFichierXML Worksheets("Feuil1").Range("A1:F20")
End Sub
 
Sub CreationFichierXML(Plage As Range)
'
'Nécessite d'activer la référence "Microsoft XML, V..."
'
Dim XnodeRoot As IXMLDOMElement, oNode As IXMLDOMNode
Dim XNom As IXMLDOMElement
Dim Cmt As IXMLDOMComment
Dim Entete As Range, Cell As Range
Dim i As Integer, j As Integer

Set Entete = Plage.Rows(1)
Set Plage = Plage.Offset(1, 0).Resize(Plage.Rows.Count - 1, Plage.Columns.Count)

'----
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
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("MonTableau")
objDOM.appendChild XnodeRoot
'Boucle sur les données du tableau
For j = 1 To Plage.Rows.Count
    Set XNom = objDOM.createElement("DonneeTableau")
    XNom.setAttribute Entete.Cells(1, 1), Plage.Cells(j, 1)
    XnodeRoot.appendChild XNom
        
    For i = 2 To Entete.Columns.Count
        CreationElement Entete.Cells(1, i), Plage.Cells(j, i), XNom
    Next i
Next j

objDOM.Save "C:\Nom Fichier.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



bonne soirée
michel
 

Discussions similaires

Réponses
12
Affichages
248

Statistiques des forums

Discussions
312 339
Messages
2 087 408
Membres
103 539
dernier inscrit
RAPH2012