Задача: результат работы стандартного отчёта необходимо выгрузить в XML файл, с применением определенных правил построения XML (заданной схемой).
В качестве решения будут использованы шаблоны для ракурса Microsoft Excel в ALV. Инструкцию о том как их использовать вы можете найти на сайте sapland.ru Excel будет выступать в качестве конвертора.
Выгрузив файл через стандартный шаблон в Excel, мы получим лишь электронную таблицу без возможности выгрузки в нужном нам XML формате.
Для того чтобы иметь возможность сохранить в нужном формате, необходимо использовать возможности Excel по выгрузке XML, а именно XML карты. В excel карты выглядят примерно следующим образом:
Открыть этот инструмент можно через панель – разработчик. Карта представляет собой структуру XML файла, элементы карты можно присваивать полям Excel документа. Предположим, что нам необходимо на выходе получать следующий формат:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
<?xml version="1.0" encoding="UTF-8"?> <tenderposition_import> <tenderpositions> <tenderposition> <amount>10.00</amount> <maxprice>1200</maxprice> <gost>ГОСТ 22123456</gost> <units>пачки.</units> <comment>Комментарий2</comment> <title>Вытяжка Krona Elis 60022 (тестовый товар)</title> <description></description> </tenderposition> </tenderpositions> </tenderposition_import> |
Для данного XML файла нам необходимо составить соответствующую карту (см. рисунок наверху). Карта может быть составлена на основе XML документа или XSD схемы. Нас интересует второй вариант. Т.к. схему нам хранить не нужно, создавать мы ее будем динамически. Присваивать элементы полям Excel так же динамически.
Один из вариантов создания XSD схемы:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
Sub BuildXSD() Dim StrMyXml As String, MyMap As XmlMap Dim StrMySchema As String Dim slideName As String Dim currentMap As XmlMap Dim processComments As Boolean For Each currentMap In ActiveWorkbook.XmlMaps ActiveWorkbook.XmlMaps(currentMap.Name).Delete Next StrMyXml = "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no"" ?>" StrMyXml = StrMyXml & "<xsd:schema xmlns:xsd=""http://www.w3.org/2001/XMLSchema"">" StrMyXml = StrMyXml & "<xsd:element name=""tenderposition_import"">" StrMyXml = StrMyXml & "<xsd:complexType>" StrMyXml = StrMyXml & "<xsd:sequence>" StrMyXml = StrMyXml & "<xsd:element name=""tenderpositions"">" StrMyXml = StrMyXml & "<xsd:complexType>" StrMyXml = StrMyXml & "<xsd:sequence>" StrMyXml = StrMyXml & "<xsd:element minOccurs=""0"" maxOccurs=""unbounded"" name=""tenderposition"">" StrMyXml = StrMyXml & "<xsd:complexType>" StrMyXml = StrMyXml & "<xsd:sequence>" StrMyXml = StrMyXml & "<xsd:element name=""amount"" type=""xsd:string""/>" StrMyXml = StrMyXml & "<xsd:element name=""maxprice"" type=""xsd:string""/>" StrMyXml = StrMyXml & "<xsd:element name=""gost"" type=""xsd:string""/>" StrMyXml = StrMyXml & "<xsd:element name=""units"" type=""xsd:string""/>" StrMyXml = StrMyXml & "<xsd:element name=""comment"" type=""xsd:string""/>" StrMyXml = StrMyXml & "<xsd:element name=""title"" type=""xsd:string""/>" StrMyXml = StrMyXml & "<xsd:element name=""description"" type=""xsd:string""/>" StrMyXml = StrMyXml & "</xsd:sequence>" StrMyXml = StrMyXml & "</xsd:complexType>" StrMyXml = StrMyXml & "</xsd:element>" StrMyXml = StrMyXml & "</xsd:sequence>" StrMyXml = StrMyXml & "</xsd:complexType>" StrMyXml = StrMyXml & "</xsd:element>" StrMyXml = StrMyXml & "</xsd:sequence>" StrMyXml = StrMyXml & "</xsd:complexType>" StrMyXml = StrMyXml & "</xsd:element>" StrMyXml = StrMyXml & "</xsd:schema>" Set MyMap = ThisWorkbook.XmlMaps.Add(StrMyXml) MyMap.ShowImportExportValidationErrors = True MyMap.PreserveColumnFilter = True MyMap.PreserveNumberFormatting = True MyMap.AdjustColumnWidth = True MyMap.Name = "mymap" StrMySchema = ThisWorkbook.XmlMaps(1).Schemas(1).XML End Sub |
Как видно из кода мы заранее подготовленную схему XSD загружаем в Excel. Далее необходимо привязать слолбцы к нужным XML полям:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
Sub CreateList() Dim lstContacts As ListObject Set mapContact = ActiveWorkbook.XmlMaps(1) For Each lstContacts In ActiveSheet.ListObjects lstContacts.Unlist Next Set lstContacts = ActiveSheet.ListObjects.Add(Destination:=ThisWorkbook.ActiveSheet.Range("A:G")) lstContacts.ShowTableStyleColumnStripes = True strXPath = "/tenderposition_import/tenderpositions/tenderposition/amount" lstContacts.ListColumns(1).XPath.SetValue mapContact, strXPath strXPath = "/tenderposition_import/tenderpositions/tenderposition/maxprice" lstContacts.ListColumns(2).XPath.SetValue mapContact, strXPath strXPath = "/tenderposition_import/tenderpositions/tenderposition/gost" lstContacts.ListColumns(3).XPath.SetValue mapContact, strXPath strXPath = "/tenderposition_import/tenderpositions/tenderposition/units" lstContacts.ListColumns(4).XPath.SetValue mapContact, strXPath strXPath = "/tenderposition_import/tenderpositions/tenderposition/comment" lstContacts.ListColumns(5).XPath.SetValue mapContact, strXPath strXPath = "/tenderposition_import/tenderpositions/tenderposition/title" lstContacts.ListColumns(6).XPath.SetValue mapContact, strXPath strXPath = "/tenderposition_import/tenderpositions/tenderposition/description" lstContacts.ListColumns(7).XPath.SetValue mapContact, strXPath End Sub |
Описывать работу с внутренними объектами VBA не стану, все можно найти по F1. Теперь необходимо вызвать данные процедуры во время открытия листа (например – Format). После чего данные на листе будут связаны с картой, их можно будет сохранить в нужном xml формате. Обратите внимание на код связывания, там жестко прописаны номера столбцов с данными. В результате связывания должно получится что-то вроде этого:
Сохранив в виде XML получим необходимую нам структуру. Таким образом, используя Excel в качестве конвертора, можно выгружать данные из ALV в XML с любой структурой.
Замечательный сайт! Это относится ко всёму сайту (не только к данной статье конкретно).
Материалы разнородные, но интересного и полезного очень много.
Успехов!
Влад, a sapper-abaper
Спасибо за отзыв