Макрос xml для excel

Microsoft Excel — Программа для работы с электронными таблицами. Она предоставляет возможности экономико-статистических расчетов, графические инструменты и язык макропрограммирования VBA (Visual Basic for Application).

Visual Basic for Applications (VBA, Visual Basic для приложений) — немного упрощённая реализация языка программирования Visual Basic, встроенная в линейку продуктов Microsoft Office, а также во многие другие программные пакеты.

XML(англ. eXtensible Markup Language — расширяемый язык разметки). XML — язык с простым формальным синтаксисом, удобный для создания и обработки документов программами и одновременно удобный для чтения и создания документов человеком. Разработчик волен создать разметку в соответствии с потребностями к конкретной области, будучи ограниченным лишь синтаксическими правилами языка.

Экспортировать данные из таблицы Excel и сформировать XML-файл с заданной структурой для последующей обработки сторонними программными продуктами.

Sub exportXML()

    'Путь для сохранения итогового XML
    xmlFile = ActiveWorkbook.Path & "export.xml"
    
    'Строка и столбец расположения названия компании
    Dim company_row As Integer
    company_row = 1
    Dim company_col As Integer
    company_col = 1
    
    'Номер строки начала таблицы с данными
    Dim data_row As Integer
    data_row = 3
    
    'Номер столбца "Порядковый номер"
    Dim num_col As Integer
    num_col = 1
    
    'Номер столбца "ФИО"
    Dim name_col As Integer
    name_col = 2
    
    'Номер столбца "Профессия"
    Dim profession_col As Integer
    profession_col = 3
    
    'Номер столбца "Наличность"
    Dim profit_col As Integer
    profit_col = 4


    'Cоздание объекта XML
    Set xml = CreateObject("MSXML2.DOMDocument")
    'Добавление описания XML
    xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
    
    'Добавление корневого элемента "company"
    Set Company = xml.createElement("company")
    'Добавление атрибута "name"
    Company.setAttribute "name", Cells(company_row, company_col)
    xml.appendChild (Company)
    
    'Цикл по строкам (пока не встретится строка с пустым "Порядковым номером")
    Do While Not IsEmpty(Cells(data_row, num_col))
       'Вызов функции добавления сотрудника компании
        Company.appendChild (createPerson(xml, Cells(data_row, num_col), _
                               Cells(data_row, name_col), _
                               Cells(data_row, profession_col), _
                               Cells(data_row, profit_col)))
        'Переход к следующей строке таблицы
        data_row = data_row + 1
    Loop
        
    'Выполнение XSL-преобразования для добавления отступов в XML
    Call transformXML(xml)
    
    'Сохранение файла (без выбора пути сохранения, удобно при отладке)
    'xml.Save xmlFile
    'MsgBox "Export complete!"

    'Сохранение файла (с выбором пути сохранения)
    xml.Save Application.GetSaveAsFilename("", "Файл экспорта (*.xml),", , "Введите имя файла", "Сохранить")

End Sub


'Функция добавления сотрудника компании(xml, "Порядковый номер", "ФИО", "Профессия", "Наличность") возвращает узел XML
Function createPerson(ByRef xml As Variant, ByVal num As Variant, ByVal name As Variant, _
                      ByVal profession As Variant, ByVal profit As Variant) As Variant

    'Создание элемента person
    Set createPerson = xml.createElement("person")
    createPerson.setAttribute "num", num
    
    'Добавление в виде комментария "Профессия" (просто для примера)
    createPerson.appendChild (xml.createComment(profession))

    'Создание элементов для столбцов "ФИО" и "Наличность"
    createPerson.appendChild(xml.createElement("name")).Text = name
    createPerson.appendChild(xml.createElement("profit")).Text = profit
    
End Function


'Процедура для придания 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

<?xml version="1.0" encoding="UTF-8"?>

<company name="ООО 'Рога и копыта'">
	<person num="1">
		<!--Великий комбинатор-->
		<name>Остап Ибрагимович Бендер</name>
		<profit>225000</profit>
	</person>
	<person num="2">
		<!--Нарушитель конвенции-->
		<name>Михаил Самуэлевич Паниковский</name>
		<profit>30000</profit>
	</person>
	<person num="3">
		<!--Водитель автомобиля «Антилопа-Гну»-->
		<name>Адам Казимирович Козлевич</name>
		<profit>95000</profit>
	</person>
	<person num="4">
		<!--Подпольный миллионер-->
		<name>Александр Иванович Корейко</name>
		<profit>1000000</profit>
	</person>
	<person num="5">
		<!--Сын лейтенанта Шмидта-->
		<name>Шура Балаганов</name>
		<profit>50000</profit>
	</person>
</company>