Sub make_xml() Dim xdoc As New DOMDocument, xtree As IXMLDOMElement Dim PI As IXMLDOMProcessingInstruction Dim LOB As IXMLDOMElement Dim fld As IXMLDOMElement 'xml header Set PI = xdoc.createProcessingInstruction(“xml", “version=’1.0′ encoding=’UTF-8′ standalone=’yes’") Call xdoc.appendChild(PI) 'root tree Set xtree = xdoc.createElement(“all") xtree.Text = vbNewLine Call xdoc.appendChild(xtree) '横軸チェック x = 1 Do While Cells(1, x) <> “": x = x + 1: Loop x = x – 1 y = 2 '縦ループ Do While Cells(y, 1) <> “" '親 Set LOB = xdoc.createElement(“data") '横ループ For i = 1 To x '子1 Set fld = xdoc.createElement(Cells(1, i)) fld.Text = Cells(y, i) Call LOB.appendChild(fld) Call LOB.appendChild(xdoc.createTextNode(vbNewLine)) Next '親書き出し Call xtree.appendChild(LOB) y = y + 1 Loop 'xml保存 xdoc.Save (“c:\temp\swlist.xml") MsgBox “done" End Sub