Developpez.com

Plus de 14 000 cours et tutoriels en informatique professionnelle à consulter, à télécharger ou à visionner en vidéo.

FAQ ExcelConsultez toutes les FAQ

Nombre d'auteurs : 46, nombre de questions : 845, dernière mise à jour : 30 mars 2017 

 
OuvrirSommaireManipuler les fichiers XML
Vba
Sélectionnez

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
Créé le 2 octobre 2007  par SilkyRoad
Vba
Sélectionnez

Sub ImporterFichierXML()
    Dim XM As XmlMap
 
    'Importe le fichier dans la cellule B1 de la Feuil3.
    ThisWorkbook.XmlImport _
        URL:="C:\Nom Fichier.xml", _
        ImportMap:=Nothing, _
        Overwrite:=True, _
        Destination:=Worksheets("Feuil3").Range("$B$1")
 
    'Définit le mappage qui vient d'être ajouté.
    'ThisWorkbook.XmlMaps.Count correspond au dernier xml mappé dans le classeur
    Set XM = ThisWorkbook.XmlMaps(ThisWorkbook.XmlMaps.Count)
 
 
    MsgBox "Import terminé" & vbCrLf & _
        XM.RootElementName & vbCrLf & _
        XM.Name & vbCrLf & _
        XM.DataBinding.SourceUrl
 
End Sub
Créé le 2 octobre 2007  par SilkyRoad
Vba
Sélectionnez

Sub SuppressionMappage()
    'La suppression est effectuée  à partir du nom de l'élément parent.
    ThisWorkbook.XmlMaps("MesDonnees_Mappage").Delete
 
    'Ou en utilisant son numéro d'index
    'ThisWorkbook.XmlMaps(1).Delete
 
    'Nota:
    'Le mappage est supprimé mais les données sont conservées dans la feuille, sous
    'forme de tableau.
 
End Sub
Créé le 2 octobre 2007  par SilkyRoad

L'évènement Workbook_AfterXmlImport est déclenché après l'insertion ou l'actualisation des données xml dans la feuille de calcul.
Le paramètre IsRefresh permet d'identifier si l'import provient d'une nouvelle source de données ou s'il s'agit de l'actualisation d'un mappage existant dans la feuille. La valeur True est renvoyée s'il s'agit d'une actualisation.

Vba
Sélectionnez

Private Sub Workbook_AfterXmlImport(ByVal Map As XmlMap, ByVal IsRefresh As Boolean, _
    ByVal Result As XlXmlImportResult)
 
    MsgBox IsRefresh & vbCrLf & _
        Map.Name 
End Sub




Pour plus d'infos, lisez le tutoriel concernant les évènements du classeur.

Créé le 5 décembre 2007  par SilkyRoad

Placez un contrôle TreeView et un CommandButton dans un UserForm pour visualiser la structure du fichier xml.

Nécessite d'activer la référence Microsoft XML, vx.x.

Vba
Sélectionnez

Option Explicit
Dim oDoc As MSXML2.DOMDocument
 
 
Private Sub CommandButton1_Click()
    Set oDoc = New DOMDocument
 
    oDoc.async = False
    oDoc.Load "C:\NomFichier.xml"
 
    TreeView1.Nodes.Clear
    AddNode oDoc.DocumentElement
End Sub
Vba
Sélectionnez

Private Function AddNode(ByRef oElem As MSXML2.IXMLDOMNode, _
        Optional ByRef oTreeNode As MSComctlLib.Node)
    Dim oNewNode As MSComctlLib.Node
    Dim oNodeList As MSXML2.IXMLDOMNodeList
    Dim i As Long
 
    If oTreeNode Is Nothing Then
        Set oNewNode = TreeView1.Nodes.Add  'Creation du noeud racine
        oNewNode.Expanded = True
        Else
        Set oNewNode = TreeView1.Nodes.Add(oTreeNode, tvwChild) 'Ajout d'un noeud enfant
        oNewNode.Expanded = True
    End If
 
    Select Case oElem.NodeType
        Case MSXML2.NODE_ELEMENT 'type Element
        oNewNode.Text = oElem.nodeName & " (" & GetAttributes(oElem) & ")"
        Set oNewNode.Tag = oElem
 
        Case MSXML2.NODE_TEXT 'type texte
        oNewNode.Text = "Text: " & oElem.NodeValue
        Set oNewNode.Tag = oElem
 
        Case MSXML2.NODE_CDATA_SECTION 'type Cdata
        oNewNode.Text = "CDATA: " & oElem.NodeValue
        Set oNewNode.Tag = oElem
 
        Case Else
        oNewNode.Text = oElem.NodeType & ": " & oElem.nodeName
        Set oNewNode.Tag = oElem
    End Select
 
 
    Set oNodeList = oElem.ChildNodes 'boucle récursive pour ajouter tous les noeuds enfants
 
    For i = 0 To oNodeList.Length - 1
        AddNode oNodeList.Item(i), oNewNode
    Next i
End Function
Vba
Sélectionnez

Private Function GetAttributes(ByRef oElm As MSXML2.IXMLDOMNode) As String
    Dim sAttr As String
    Dim i As Long
 
    sAttr = ""
 
    For i = 0 To oElm.Attributes.Length - 1 'boucle sur tous les attributs
        sAttr = sAttr & oElm.Attributes.Item(i).nodeName & "='" & _
            oElm.Attributes.Item(i).NodeValue & "' "
    Next i
 
    GetAttributes = sAttr
End Function
Créé le 5 décembre 2007  par SilkyRoad

Vous pouvez effectuer l'opération depuis l'index de l'objet (1= le premier mappage dans le classeur) :

Vba
Sélectionnez

ThisWorkbook.XmlMaps(1).DataBinding.Refresh




Ou en précisant son nom, si vous le connaissez

Vba
Sélectionnez

ThisWorkbook.XmlMaps("développez_Mappage").DataBinding.Refresh
Créé le 20 septembre 2008  par SilkyRoad

Cliquez sur le bouton Office
Menu "Ouvrir"
Sélectionnez le fichier xml à ouvrir
Cliquez sur le bouton "Ouvrir"
Une boîte de dialogue s'affiche
Sélectionnez l'option "En tant que tableau XML"
Cliquez sur le bouton OK pour valider.


par macro :

Vba
Sélectionnez

Workbooks.OpenXML Filename:= _
    "C:\dossier\NomFichier.xml", _
    LoadOption:=xlXmlLoadImportToList
Créé le 20 septembre 2008  par SilkyRoad

Sélectionnez l'onglet Développeur dans le ruban.
Cliquez sur le bouton Source dans le groupe XML.
Le volet de gestion des sources XML s'affiche.
Cliquez sur le bouton "Mappage XML" dans le volet.
Cliquez sur le bouton "Ajouter" dans la nouvelle boîte de dialogue qui apparait.
Recherchez le fichier .xsd sur votre disque dur puis cliquez sur le bouton "Ouvrir" pour valider.
La structure du mappage apparait dans le volet XML.
Faites un Glisser/Déposer du volet XML vers la feuille de calcul pour afficher le mappage dans les cellules.

Créé le 18 novembre 2008  par SilkyRoad
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2009 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.