Экспортирование из xls в xml(VBA)

[manula]

Спасибо всем огромное за помощь,а еще уважаемые программисты не могли вы бы подправить файл который я прикрепил ниже,там нужно подправить кнопку "Выгрузка в xml-файл" я внутри макроса кнопки прописал комментарии, что нужно подправить,просто сам никак допереть не могу.примного благодарен

[manula]

doober огромное Вам спасибо за помощь и потраченное ваше время,а можно еще такой вопрос,как мне подсчитать сумму столбца F в вашем документе,допустим мне нужно подсчитать и переслать в тег СуммаИтого:
<Сумма>21324,09<Сумма>
.......
<Сумма>4324,43<Сумма>
</Зачислениия>
<СуммаИтого> Сумма всех "сумм"</СуммаИтого>
</СчетПК>
Вот на подобие такой схемы,не могли Вы мне еще помочь с этим,я просто до этого мало программировал с среде VBA поэтому некоторые моменты вызывают затруднения.Благодарю!

[doober]

Const strFilePath As String = "C:\TestXML.xml"
Sub ExtportToXML()
    Dim objDoc As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMNode
    Dim objRoot As MSXML2.IXMLDOMElement
    Dim objElem As MSXML2.IXMLDOMElement
    Dim ar As Variant
     Dim M_summ As Currency
    Dim i As Integer
    Set objDoc = New DOMDocument
    objDoc.resolveExternals = True
    Set objNode = objDoc.createProcessingInstruction( _
        "xml", "version='1.0' encoding='windows-1251'")
    Set objNode = objDoc.InsertBefore(objNode, _
    objDoc.ChildNodes.Item(0))
    Set objRoot = objDoc.createElement("СчетаПК")
    Set objDoc.DocumentElement = objRoot
    objRoot.setAttribute "ДатаФормирования", "20.02.2012"
    objRoot.setAttribute "НомерДоговора", "123"
   i = 1
   M_summ = 0
  Do
    Set objElem = objDoc.createElement("Сотрудник")
      objElem.setAttribute "Нпп", Cells(i, 1)
      objRoot.appendChild objElem
           Set objNode = objDoc.createElement("Фамилия")
            objNode.Text = Cells(i, 2)
            objElem.appendChild objNode
        Set objNode = objDoc.createElement("Имя")
            objNode.Text = Cells(i, 3)
            objElem.appendChild objNode
        Set objNode = objDoc.createElement("Отчество")
            objNode.Text = Cells(i, 4)
            objElem.appendChild objNode
      Set objNode = objDoc.createElement("ЛицевойСчет")
            objNode.Text = Cells(i, 5)
            objElem.appendChild objNode
      Set objNode = objDoc.createElement("Сумма")
            objNode.Text = Cells(i, 6)
            M_summ = M_summ + CDbl(Cells(i, 6))
            
            objElem.appendChild objNode
      i = i + 1
 Loop Until Cells(i, 1) = ""
   Set objElem = objDoc.createElement("СуммаИтого")
 objElem.Text = M_summ
 objRoot.appendChild objElem
 
    objDoc.Save strFilePath
End Sub

[manula]

Уважаемый doober не могли бы Вы мне помочь вот еще с какой проблемой,у меня есть форма на ней ListBox, при выборе одного из пунктов и нажатию на кнопку создается столько файлов, сколько соответствует данному пункту.
Пример:
- при выборе "данные1" формируется 1 xml-файл,
- при выборе "данные2" формируется 2 xml-файл,
структура у всех файлов одинаковая
И еще не могли бы вы дать мне источники где можно поподробнее изучить работу с DOMDocuments, я бы хотел поближе познакомиться с этим методом.Благодарю за потраченное время,огромное Вам спасибо.

[doober]

Скачайте по ссылке,документация входит в комплект,только на вражеском языке
Есть еще такой сайт http://social.msdn.microsoft.com
А по вашей просьбе ничего не понял,мало информации ,да и волоски в бороде уже заканчиваются

[nerv]

DOM в примерах
Обход DOM
Атрибуты и пользовательские свойства
Добавление и удаление узлов

[manula]

Сообщение от doober

Скачайте по ссылке,документация входит в комплект,только на вражеском языке
Есть еще такой сайт http://social.msdn.microsoft.com
А по вашей просьбе ничего не понял,мало информации ,да и волоски в бороде уже заканчиваются

А именно, что непонятно?какой информации мало,просто вот остался один подводный камень, с которым мне нужна помощь,а за источники и материал,благодарю.

[Evrica]

doober, скачал твой конвертер, есть вопрос

нужно привести xml файл к виду
<list_clients>
<id_merch>1</id_merch>
<client_info ident="счет" info="ФИО" />
<client_info ident="счет" info="адрес" />
</list_clients>

получилось почти все, только нету закрывающего тега </list_clients>, в начале пишет <list_clients />

[doober]

Сообщение от Evrica

doober, скачал твой конвертер, есть вопрос

Он не мой.

Где код самого макроса?

[Evrica]

ну я видел что ты выкладывал его))

Sub ExtportToXML()
    Dim objDoc As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMNode
    Dim objRoot As MSXML2.IXMLDOMElement
    Dim objElem As MSXML2.IXMLDOMElement
    Dim ar As Variant
    Dim i As Integer
    Set objDoc = New DOMDocument
    objDoc.resolveExternals = True
    Set objNode = objDoc.createProcessingInstruction( _
        "xml", "version='1.0' encoding='windows-1251'")
    Set objNode = objDoc.InsertBefore(objNode, _
    objDoc.ChildNodes.Item(0))
    Set objRoot = objDoc.createElement("Äàííûå")
    Set objDoc.DocumentElement = objRoot
   i = 1
  Do
    Set objElem = objDoc.createElement("list_clients")
        objRoot.appendChild objElem
               
               
        Set objNode = objDoc.createElement("id_merch")
            objNode.Text = Cells(i, 1)
            objElem.appendChild objNode
        
            
        Set objElem = objDoc.createElement("client_info")
            objElem.setAttribute "ident", Cells(i, 2)
            objNode.appendChild objElem
            objElem.setAttribute "info", Cells(i, 3)
            objRoot.appendChild objElem

        Set objElem = objDoc.createElement("client_info")
            objElem.setAttribute "ident", Cells(i, 4)
            objRoot.appendChild objElem
            objElem.setAttribute "info", Cells(i, 5)
            objRoot.appendChild objElem
            objElem.setAttribute "rest", Cells(i, 6)
            objRoot.appendChild objElem


      i = i + 1
 Loop Until Cells(i, 1) = ""
    objDoc.Save strFilePath
End Sub