Здравствуйте!
Прошу помочь в корректировке макроса, который конвертирует таблицу из Excel в XML, а именно, чтобы в начале результирующего xml файла формировались 5 строк после строки кодировки и во всех тэгах результирующего файла присутствовал префикс sst:
<sst:Claim xmlns:sst=">
<sst:nгmber1>555</sst:nгmber1>
<sst:nгmber2>777</sst:nгmber2>
<sst:nгmber3>888</sst:nгmber3>
<sst:nгmber4>999</sst:nгmber4>
В примере файла это заполненные данные в 3 и 4 строках.
Прошу помочь в корректировке макроса, который конвертирует таблицу из Excel в XML, а именно, чтобы в начале результирующего xml файла формировались 5 строк после строки кодировки и во всех тэгах результирующего файла присутствовал префикс sst:
<sst:Claim xmlns:sst=">
<sst:nгmber1>555</sst:nгmber1>
<sst:nгmber2>777</sst:nгmber2>
<sst:nгmber3>888</sst:nгmber3>
<sst:nгmber4>999</sst:nгmber4>
В примере файла это заполненные данные в 3 и 4 строках.
| Код |
|---|
Sub exportXML()
'Путь для сохранения итогового XML
xmlFile = ActiveWorkbook.Path & "\export.xml"
Dim k, m As Integer
k = 8
m = 1
'Cоздание объекта XML
Set xml = CreateObject("MSXML2.DOMDocument")
'Добавление описания XML
xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
'Добавление корневого элемента
Set rootnode = xml.appendChild(xml.createElement("ListN1"))
'Цикл по строкам до пустой
Do While Not IsEmpty(Cells(k, 7))
With rootnode.appendChild(xml.createElement("ListN2")) ' создаём узел в XML и добавляем в него значения
ColumnName$ = Cells(7, 1)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 1)
ColumnName$ = Cells(7, 2)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 2)
ColumnName$ = Cells(7, 3)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 3)
ColumnName$ = Cells(7, 4)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 4)
ColumnName$ = Cells(7, 5)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 5)
With .appendChild(xml.createElement("ListN3"))
ColumnName$ = Cells(7, 6)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 6)
ColumnName$ = Cells(7, 7)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 7)
End With
ColumnName$ = Cells(7, 8)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 8)
ColumnName$ = Cells(7, 9)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 9)
With .appendChild(xml.createElement("ListN4"))
With .appendChild(xml.createElement("ListN5"))
With .appendChild(xml.createElement("ListN6"))
ColumnName$ = Cells(7, 10)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 10)
End With
ColumnName$ = Cells(7, 11)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 11)
ColumnName$ = Cells(7, 12)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 12)
ColumnName$ = Cells(7, 13)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 13)
ColumnName$ = Cells(7, 14)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 14)
With .appendChild(xml.createElement("ListN7"))
ColumnName$ = Cells(7, 15)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 15)
End With
ColumnName$ = Cells(7, 16)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 16)
With .appendChild(xml.createElement("ListN8"))
With .appendChild(xml.createElement("ListN9"))
ColumnName$ = Cells(7, 17)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 17)
ColumnName$ = Cells(7, 18)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 18)
End With
End With
End With
End With
With .appendChild(xml.createElement("ListN10"))
ColumnName$ = Cells(7, 19)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 19)
End With
With .appendChild(xml.createElement("ListN11"))
ColumnName$ = Cells(7, 20)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 20)
End With
With .appendChild(xml.createElement("ListN12"))
ColumnName$ = Cells(7, 21)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 21)
End With
ColumnName$ = Cells(7, 22)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 22)
ColumnName$ = Cells(7, 23)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 23)
With .appendChild(xml.createElement("ListN13"))
With .appendChild(xml.createElement("ListN14"))
ColumnName$ = Cells(7, 24)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 24)
ColumnName$ = Cells(7, 25)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 25)
ColumnName$ = Cells(7, 26)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 26)
ColumnName$ = Cells(7, 27)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 27)
End With
End With
ColumnName$ = Cells(7, 28)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 28)
ColumnName$ = Cells(7, 29)
.appendChild(xml.createElement(ColumnName$)).Text = Cells(k, 29)
End With
k = k + 1
Loop
'Выполнение XSL-преобразования для добавления отступов в XML
Call transformXML(xml)
'Сохранение файла (без выбора пути сохранения, удобно при отладке)
xml.Save xmlFile
'MsgBox "Export complete!"
'Сохранение файла (с выбором пути сохранения)
'xml.Save Application.GetSaveAsFilename("", "Файл экспорта (*.xml),", , "Введите имя файла", "Сохранить")
End Sub
'Процедура для придания XML читабельного вида (с отступами)
Sub transformXML(ByRef xml As Variant)
'Cоздание объекта XSL
Set xsl = CreateObject("MSXML2.DOMDocument")
'Загрузка XSL из строки (не требует наличия отдельного XSL-файла)
xsl.LoadXML ("<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>" & vbCrLf & _
"<xsl:output method='xml' version='1.0' encoding='UTF-8' indent='yes'/>" & vbCrLf & _
"<xsl:template match='@*|node()'>" & vbCrLf & _
"<xsl:copy>" & vbCrLf & _
"<xsl:apply-templates select='@*|node()' />" & vbCrLf & _
"</xsl:copy>" & vbCrLf & _
"</xsl:template>" & vbCrLf & _
"</xsl:stylesheet>")
'Выполнение преобразования
xml.transformNodeToObject xsl, xml
End Sub
|
Изменено: - 16.05.2024 22:33:16
(в файле XML пример удалил не нужные карты XML)
