disashy
Messages postés3Date d'inscriptionlundi 8 février 2010StatutMembreDernière intervention29 juillet 2010 29 juil. 2010 à 02:05
Merci pour to precieux travail, Christian.
J'ai rentre to code dans un module, mais j'obtiens une erreur "compile?".
Mon code fonctionne bien chez moi mais pas au bureau, et l'apostrophe dans le chemin d'acces ne semble pas influencer l'execution(pas d'apostrophe au travail).
J'ai du recourir a code suivant, plus mecanique, qui fonctionne bien au travail: Je convertis xl en txt en inserrant les balises et je sauve le fichier txt sosu forme xml.
Code:
Option Explicit
Dim objDOM As DOMDocument
Sub CreationFichier01()
'Définit la Range 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 ActiveSheet.Range("A1:F6")
End Sub
Sub CreationFichierXML(Range As Range)
'
'Nécessite d'activer la référence "Microsoft XML, V..."
'
Dim XnodeRoot As IXMLDOMElement, oNode As IXMLDOMNode
Dim XName As IXMLDOMElement
Dim XNameChild As IXMLDOMCDATASection
Dim Cmt As IXMLDOMComment
Dim Head As Range, Cell As Range
Dim I As Integer, j As Integer
Dim xmlDoc As New DOMDocument40
Dim rdr As New SAXXMLReader40
Dim wrt As New MXXMLWriter40
Set Head = Range.Rows(1)
Set Range = Range.Offset(1, 0).Resize(Range.Rows.Count - 1, Range.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("Converted by " & Environ("username") & ", " & 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("markers")
objDOM.appendChild XnodeRoot
'Boucle sur les données du tableau
For j = 2 To Range.Rows.Count
Set XName = objDOM.createElement("marker")
For I = 1 To Head.Columns.Count
XName.setAttribute Head.Cells(1, I), Range.Cells(j - 1, I)
Next I
'Load the DOM document.
xmlDoc.async = False
xmlDoc.resolveExternals = False
xmlDoc.Load "C:\Users\Tex'Ance\Desktop\macroParfaitFichier01.xml"
'Set properties on the XML writer.
wrt.byteOrderMark = True
wrt.omitXMLDeclaration = False
wrt.indent = True
'Set the XML writer to the SAX content handler.
Set rdr.contentHandler = wrt
Set rdr.dtdHandler = wrt
Set rdr.errorHandler = wrt
'Parse the DOMDocument object.
rdr.Parse xmlDoc
MsgBox wrt.output
xmlDoc.loadXML wrt.output
xmlDoc.Save "C:\Users\Tex'Ance\Desktop\macroParfait_Fichier01.xml"
End Sub
Sub CreationElement(strElem As String, Data As Variant, oNom As IXMLDOMElement)
Dim XInfos As IXMLDOMNode
Set XInfos = objDOM.createElement(strElem)
XInfos.Text = Data
oNom.appendChild XInfos
End Sub
Sub ConvertToTXT()
Dim MyStr As String, PageName As String, FirstRow As Integer, LastRow As Integer, MyRow As Integer
PageName = "C:\Users\Tex'Ance\Desktop\20Juil\TextFileFW" & Format(Time, "HHMM") & ".txt" ' location and Name of saved file
Print #1, MyStr
Next
Print #1, " " & "</Markers>"
Close #1
ActiveSheet.Range("G2").ClearContents ' note that this row expects the worksheet to be named DATA
ActiveSheet.Hyperlinks.Add Range("G2"), PageName
End Sub
=============
'Dans le meme ordre d'idee, j'ai essaye un autre code qui fonctionne bien chez moi (mais de nouveau pas au travail), mais ou le fichier est plus general et directement converti en xml:
Mayzz
Messages postés2812Date d'inscriptionmardi 15 avril 2003StatutMembreDernière intervention 2 juin 202028 25 juil. 2010 à 16:38
disashy > Tu n'es pas au bon endroit pour poser tes questions, il y a le forum pour cela.
christian_grandjean
Messages postés25Date d'inscriptiondimanche 7 novembre 2004StatutMembreDernière intervention19 novembre 20132 24 juil. 2010 à 08:00
Bonjour,
Je ne vois rien qui saute aux yeux dans votre code, une seule chose me dérange c'est le chemin utilisé File = "C:\Users\Tex'Ance\Desktop\test2.xml" il y a un ' apostrophe dans le chemin je ne sais pas si c'est désiré.
Salutations
http://www.simple-tech.info
disashy
Messages postés3Date d'inscriptionlundi 8 février 2010StatutMembreDernière intervention29 juillet 2010 14 juil. 2010 à 20:26
Mon code est le suivant:
Option Explicit
Option Base 1
Sub XMLmarkers()
Dim xmlDoc As MSXML2.DOMDocument
Dim xmLstring As String, File As String, strQuote As String
Dim Row As Integer, Col As Integer
Dim Attribut As Variant
For Row = 2 To Sheets("Sheet1").UsedRange.Rows.Count
xmLstring = xmLstring & "<marker "
For Col = 1 To 7
xmLstring = xmLstring & Attribut(Col) & "=" & _
strQuote & Cells(Row, Col) & strQuote & " "
Next
xmLstring = xmLstring & " />"
xmLstring = xmLstring & " "
Next Row
xmLstring = xmLstring & "</Markers>"
xmlDoc.loadXML xmLstring
File = "C:\Users\Tex'Ance\Desktop\test2.xml"
xmlDoc.Save (File)
End Sub
disashy
Messages postés3Date d'inscriptionlundi 8 février 2010StatutMembreDernière intervention29 juillet 2010 14 juil. 2010 à 20:25
bonjour, j'ai le code suivant pour creer un fichier xml depuis excel 2003.Chez mioi, le fichier xml est parfiait, mais au travail (intranet), le fichier xml cree est vide.
Aidez-moi, svp.
Disa
radcur
Messages postés282Date d'inscriptionlundi 29 septembre 2003StatutMembreDernière intervention15 août 20122 6 juil. 2010 à 14:53
Super!
j'avais justement besoin d'un exemple comme ca pour ce que je voulais faire avec un fichier XML
Mayzz
Messages postés2812Date d'inscriptionmardi 15 avril 2003StatutMembreDernière intervention 2 juin 202028 4 juil. 2010 à 22:33
29 juil. 2010 à 02:05
J'ai rentre to code dans un module, mais j'obtiens une erreur "compile?".
Mon code fonctionne bien chez moi mais pas au bureau, et l'apostrophe dans le chemin d'acces ne semble pas influencer l'execution(pas d'apostrophe au travail).
J'ai du recourir a code suivant, plus mecanique, qui fonctionne bien au travail: Je convertis xl en txt en inserrant les balises et je sauve le fichier txt sosu forme xml.
Code:
Option Explicit
Dim objDOM As DOMDocument
Sub CreationFichier01()
'Définit la Range 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 ActiveSheet.Range("A1:F6")
End Sub
Sub CreationFichierXML(Range As Range)
'
'Nécessite d'activer la référence "Microsoft XML, V..."
'
Dim XnodeRoot As IXMLDOMElement, oNode As IXMLDOMNode
Dim XName As IXMLDOMElement
Dim XNameChild As IXMLDOMCDATASection
Dim Cmt As IXMLDOMComment
Dim Head As Range, Cell As Range
Dim I As Integer, j As Integer
Dim xmlDoc As New DOMDocument40
Dim rdr As New SAXXMLReader40
Dim wrt As New MXXMLWriter40
Set Head = Range.Rows(1)
Set Range = Range.Offset(1, 0).Resize(Range.Rows.Count - 1, Range.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("Converted by " & Environ("username") & ", " & 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("markers")
objDOM.appendChild XnodeRoot
'Boucle sur les données du tableau
For j = 2 To Range.Rows.Count
Set XName = objDOM.createElement("marker")
For I = 1 To Head.Columns.Count
XName.setAttribute Head.Cells(1, I), Range.Cells(j - 1, I)
Next I
XnodeRoot.appendChild XName
Next j
objDOM.Save "C:\Users\Tex'Ance\Desktop\macroParfaitFichier01.xml"
Set XnodeRoot = Nothing
Set objDOM = Nothing
'Load the DOM document.
xmlDoc.async = False
xmlDoc.resolveExternals = False
xmlDoc.Load "C:\Users\Tex'Ance\Desktop\macroParfaitFichier01.xml"
'Set properties on the XML writer.
wrt.byteOrderMark = True
wrt.omitXMLDeclaration = False
wrt.indent = True
'Set the XML writer to the SAX content handler.
Set rdr.contentHandler = wrt
Set rdr.dtdHandler = wrt
Set rdr.errorHandler = wrt
'Parse the DOMDocument object.
rdr.Parse xmlDoc
MsgBox wrt.output
xmlDoc.loadXML wrt.output
xmlDoc.Save "C:\Users\Tex'Ance\Desktop\macroParfait_Fichier01.xml"
End Sub
Sub CreationElement(strElem As String, Data As Variant, oNom As IXMLDOMElement)
Dim XInfos As IXMLDOMNode
Set XInfos = objDOM.createElement(strElem)
XInfos.Text = Data
oNom.appendChild XInfos
End Sub
Sub ConvertToTXT()
Dim MyStr As String, PageName As String, FirstRow As Integer, LastRow As Integer, MyRow As Integer
PageName = "C:\Users\Tex'Ance\Desktop\20Juil\TextFileFW" & Format(Time, "HHMM") & ".txt" ' location and Name of saved file
Open PageName For Output As #1
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " " & "encoding=" & Chr(34) & "utf - 8" & Chr(34) & " " & "?>"
Print #1, " " & "<Markers>"
For MyRow = 2 To 20 ' loop through each row of the table
MyStr = ""
MyStr = " " & "<marker Lat= " & Chr(34) & Cells(MyRow, 1).Value & Chr(34) & " " & "Lng=" & Chr(34) & _
Cells(MyRow, 2).Value & Chr(34) & " " & "Address=" & Chr(34) & Cells(MyRow, 3).Value & Chr(34) & " " & _
"Postcode= " & Chr(34) & Cells(MyRow, 4).Value & Chr(34) & " " & "Name=" & Chr(34) & Cells(MyRow, 5).Value & _
Chr(34) & " " & "Category=" & Chr(34) & Cells(MyRow, 6).Value & Chr(34) & "/>"
Print #1, MyStr
Next
Print #1, " " & "</Markers>"
Close #1
ActiveSheet.Range("G2").ClearContents ' note that this row expects the worksheet to be named DATA
ActiveSheet.Hyperlinks.Add Range("G2"), PageName
End Sub
=============
'Dans le meme ordre d'idee, j'ai essaye un autre code qui fonctionne bien chez moi (mais de nouveau pas au travail), mais ou le fichier est plus general et directement converti en xml:
25 juil. 2010 à 16:38
24 juil. 2010 à 08:00
Je ne vois rien qui saute aux yeux dans votre code, une seule chose me dérange c'est le chemin utilisé File = "C:\Users\Tex'Ance\Desktop\test2.xml" il y a un ' apostrophe dans le chemin je ne sais pas si c'est désiré.
Salutations
http://www.simple-tech.info
14 juil. 2010 à 20:26
Option Explicit
Option Base 1
Sub XMLmarkers()
Dim xmlDoc As MSXML2.DOMDocument
Dim xmLstring As String, File As String, strQuote As String
Dim Row As Integer, Col As Integer
Dim Attribut As Variant
strQuote = """"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmLstring = "<?xml version=""1.0"" encoding=""utf-8"" ?> "
xmLstring = xmLstring & "<Markers TitleName=" & strQuote _
& "markers" & strQuote & "> "
Attribut = Array("Lat", "Lng", "Postcode", "Address", "Name", "Category", "Description")
For Row = 2 To Sheets("Sheet1").UsedRange.Rows.Count
xmLstring = xmLstring & "<marker "
For Col = 1 To 7
xmLstring = xmLstring & Attribut(Col) & "=" & _
strQuote & Cells(Row, Col) & strQuote & " "
Next
xmLstring = xmLstring & " />"
xmLstring = xmLstring & " "
Next Row
xmLstring = xmLstring & "</Markers>"
xmlDoc.loadXML xmLstring
File = "C:\Users\Tex'Ance\Desktop\test2.xml"
xmlDoc.Save (File)
End Sub
14 juil. 2010 à 20:25
Aidez-moi, svp.
Disa
6 juil. 2010 à 14:53
j'avais justement besoin d'un exemple comme ca pour ce que je voulais faire avec un fichier XML
4 juil. 2010 à 22:33