Краткая справка:

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-файл с заданной структурой для последующей обработки сторонними программными продуктами.

Исходная таблица с некоторыми данными:

Код VBA:

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:

<?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>

8 ответы
  1. Дмитрий
    Дмитрий говорит:

    Как при сохранении запрашивать путь для экспортируемого файла? Чтобы открывалось диалоговое окно «Сохранить как…»?

    Ответить
    • admin
      admin говорит:

      Вызов диалогового окна «Сохранить как…»:

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

      Добавил изменения в код.

      Ответить
  2. Andrey
    Andrey говорит:

    Получаю ошибку : Keword xsl:output may not contain xsl:template
    при вызове : xml.transformNodeToObject xsl, xml
    Подскажите в чём беда ?

    Ответить
    • admin
      admin говорит:

      Возможно, проблема с MSXML. Список установленных версий можно найти в реестре:
      HKEY_CLASSES_ROOTCLSID{2933BF90-7B36-11D2-B20E-00C04F983E60}VersionList

      Статья «Установка и распространение MSXML»
      https://msdn.microsoft.com/ru-ru/library/cc507432%28v=vs.85%29.aspx

      Как вариант, скачайте Portable Microsoft Office 2007 SP3 и попробуйте открыть и выполнить скрипт в нем.

      Ответить
  3. vova
    vova говорит:

    «Получаю ошибку : Keword xsl:output may not contain xsl:template
    при вызове : xml.transformNodeToObject xsl, xml
    Подскажите в чём беда ?»:

    xsl.LoadXML («» & vbCrLf & _
    «» & vbCrLf & _
    «» & vbCrLf & _
    «» & vbCrLf & _
    «» & vbCrLf & _
    «» & vbCrLf & _
    «» & vbCrLf & _
    «»)

    Ответить
  4. Дмитрий
    Дмитрий говорит:

    Добрый день, Такая же ошибка, как и остальных в этой ветке. В реестре в VersionList у меня две версии 3.0 и 6.0, я так понимаю, нужно одну из них как то удалить?

    Ответить
  5. Дмитрий
    Дмитрий говорит:

    Keword xsl:output may not contain xsl:template
    при вызове : xml.transformNodeToObject xsl, xml Получил эту ошибку, проследовал в реестре до вкладки VersionList Оказалось две версии 3.0 и 6.0 . Я так понимаю одна лишняя, какую оставить

    Ответить
  6. Александр
    Александр говорит:

    А если у меня в экселевский файл уже вставлена схема сопоставления XML. Т.е. при ручном сохранении в XML, генерируется XML в соответствии с схемой XML.
    Как такого же добиться через VBA? Как Заставить VBA учитывать внедренную карту XML при экспорте страницы в XML&

    Ответить

Ответить

Хотите присоединиться к обсуждению?
Не стесняйтесь вносить свой вклад!

Добавить комментарий для admin Отменить ответ

Ваш e-mail не будет опубликован. Обязательные поля помечены *