Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/VBA + XML: Изменение аттрибута узла xml (?) - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » VBA + XML: Изменение аттрибута узла xml (?) (Макросы/Sub)
VBA + XML: Изменение аттрибута узла xml (?)
Benos Дата: Суббота, 09.10.2021, 22:22 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013 / 2016 / 365
Приветствую всех!
Столкнулся с задачей и уже неделю не могу решить...
Есть таблица при изменении значений в ней, должна происходить запись значений в xml и соответственно при необходимости обновлять данные из xml.
Загрузку данных реализовал, а вот с записью изменений беда.
XML:
[vba]
Код
<?xml version="1.0" encoding="utf-8"?>
<info>
    <cust ID="ID1" VAL="1111"/>
    <cust ID="ID2" VAL="2222"/>
    <cust ID="ID3" VAL="3333"/>
    <cust ID="ID4" VAL="4444"/>
    <cust ID="ID5" VAL="5555"/>
    <cust ID="ID6" VAL="6666"/>
    <cust ID="ID7" VAL="7777"/>
</info>
[/vba]

Модуль загрузки
[vba]
Код

Public read As String
Sub LoadInfo()
    read = "OFF"
Dim xmlDoc As MSXML2.DOMDocument60
Set xmlDoc = New MSXML2.DOMDocument60
Dim xmlNode As MSXML2.IXMLDOMNode
Dim xmlNodes As MSXML2.IXMLDOMNodeList
Dim iRow As Integer
Dim nameBook As String
    nameBook = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)

    xmlDoc.Load (ActiveWorkbook.Path & "\" & nameBook & ".xml")
    Set xmlNodes = xmlDoc.SelectNodes("//info/cust")
    If xmlNodes.Length < 1 Then
        Exit Sub
    Else
        iRow = Range("Сводная_ID").Row
        For Each xmlNode In xmlNodes
            iRow = iRow + 1
            Call readItem(iRow, "ID", xmlNode)
            Call readItem(iRow, "VAL", xmlNode)
        Next
    End If
    read = "ON"
End Sub
Sub readItem(iRow, iName, iXmlNode)
    If Cells(iRow, Range("Сводная_" & iName).Column).text <> iXmlNode.Attributes.getNamedItem(iName).text Then
       Cells(iRow, Range("Сводная_" & iName).Column).Value = iXmlNode.Attributes.getNamedItem(iName).text
       Cells(iRow, Range("Сводная_" & iName).Column).Interior.Color = vbYellow
    Else
       Cells(iRow, Range("Сводная_" & iName).Column).Interior.Color = xlNone
    End If
End Sub

[/vba]

Код сохранение изменений (который не могу допилить)
[vba]
Код

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim iRow As Integer
    Dim iName As String
    Dim pZero As Integer
        pZero = Range("Сводная_ID").Row
    Dim lastCol As Integer
        lastCol = Cells(pZero, Columns.Count).End(xlToLeft).Column
    If read = "OFF" Then Exit Sub
    If Target.Column < lastCol And Target.Row > pZero Then
        Call wrXML(Target, pZero)
    End If
End Sub
Sub wrXML(iTarget, iZero)
    Dim xmlDoc As MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlRoot As MSXML2.IXMLDOMNode
    Dim nameBook As String
        nameBook = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
    xmlDoc.Load (ActiveWorkbook.Path & "\" & nameBook & ".xml")
           
    Set xmlRoot = xmlDoc.SelectSingleNode("//info/cust[@" & Split(Cells(iZero, 1).Name.Name, "_")(1) & "='" & Cells(iTarget.Row, 1).Value & "']")
    If Not xmlRoot Is Nothing Then
        Debug.Print "Bingo - Change Value"
        ' тут пытался записать новое значение в атрибут но не могу понять как
        ' перепробовал кучу вариантов...
    Else
        Debug.Print "No Bingo - Create New Node with Attr"
    End If
    
    xmlDoc.Save (ActiveWorkbook.Path & "\" & nameBook & ".xml")
End Sub
[/vba]
Все варианты перезаписи значения "VAL" которые нашел не срабатывают.
Подскажите кто знает, как перезаписать значение атрибута по имени

Файлы приложил.
Буду очень признателен.
К сообщению приложен файл: test_a.xml(0.3 Kb) · test_a.xlsm(25.9 Kb)


Сообщение отредактировал Benos - Суббота, 09.10.2021, 22:24
 
Ответить
СообщениеПриветствую всех!
Столкнулся с задачей и уже неделю не могу решить...
Есть таблица при изменении значений в ней, должна происходить запись значений в xml и соответственно при необходимости обновлять данные из xml.
Загрузку данных реализовал, а вот с записью изменений беда.
XML:
[vba]
Код
<?xml version="1.0" encoding="utf-8"?>
<info>
    <cust ID="ID1" VAL="1111"/>
    <cust ID="ID2" VAL="2222"/>
    <cust ID="ID3" VAL="3333"/>
    <cust ID="ID4" VAL="4444"/>
    <cust ID="ID5" VAL="5555"/>
    <cust ID="ID6" VAL="6666"/>
    <cust ID="ID7" VAL="7777"/>
</info>
[/vba]

Модуль загрузки
[vba]
Код

Public read As String
Sub LoadInfo()
    read = "OFF"
Dim xmlDoc As MSXML2.DOMDocument60
Set xmlDoc = New MSXML2.DOMDocument60
Dim xmlNode As MSXML2.IXMLDOMNode
Dim xmlNodes As MSXML2.IXMLDOMNodeList
Dim iRow As Integer
Dim nameBook As String
    nameBook = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)

    xmlDoc.Load (ActiveWorkbook.Path & "\" & nameBook & ".xml")
    Set xmlNodes = xmlDoc.SelectNodes("//info/cust")
    If xmlNodes.Length < 1 Then
        Exit Sub
    Else
        iRow = Range("Сводная_ID").Row
        For Each xmlNode In xmlNodes
            iRow = iRow + 1
            Call readItem(iRow, "ID", xmlNode)
            Call readItem(iRow, "VAL", xmlNode)
        Next
    End If
    read = "ON"
End Sub
Sub readItem(iRow, iName, iXmlNode)
    If Cells(iRow, Range("Сводная_" & iName).Column).text <> iXmlNode.Attributes.getNamedItem(iName).text Then
       Cells(iRow, Range("Сводная_" & iName).Column).Value = iXmlNode.Attributes.getNamedItem(iName).text
       Cells(iRow, Range("Сводная_" & iName).Column).Interior.Color = vbYellow
    Else
       Cells(iRow, Range("Сводная_" & iName).Column).Interior.Color = xlNone
    End If
End Sub

[/vba]

Код сохранение изменений (который не могу допилить)
[vba]
Код

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim iRow As Integer
    Dim iName As String
    Dim pZero As Integer
        pZero = Range("Сводная_ID").Row
    Dim lastCol As Integer
        lastCol = Cells(pZero, Columns.Count).End(xlToLeft).Column
    If read = "OFF" Then Exit Sub
    If Target.Column < lastCol And Target.Row > pZero Then
        Call wrXML(Target, pZero)
    End If
End Sub
Sub wrXML(iTarget, iZero)
    Dim xmlDoc As MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlRoot As MSXML2.IXMLDOMNode
    Dim nameBook As String
        nameBook = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
    xmlDoc.Load (ActiveWorkbook.Path & "\" & nameBook & ".xml")
           
    Set xmlRoot = xmlDoc.SelectSingleNode("//info/cust[@" & Split(Cells(iZero, 1).Name.Name, "_")(1) & "='" & Cells(iTarget.Row, 1).Value & "']")
    If Not xmlRoot Is Nothing Then
        Debug.Print "Bingo - Change Value"
        ' тут пытался записать новое значение в атрибут но не могу понять как
        ' перепробовал кучу вариантов...
    Else
        Debug.Print "No Bingo - Create New Node with Attr"
    End If
    
    xmlDoc.Save (ActiveWorkbook.Path & "\" & nameBook & ".xml")
End Sub
[/vba]
Все варианты перезаписи значения "VAL" которые нашел не срабатывают.
Подскажите кто знает, как перезаписать значение атрибута по имени

Файлы приложил.
Буду очень признателен.

Автор - Benos
Дата добавления - 09.10.2021 в 22:22
doober Дата: Воскресенье, 10.10.2021, 14:26 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 835
Репутация: 303 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте.[vba]
Код
xmlRoot.Attributes.getNamedItem("ID").Text = "Новое значение для атрибута"
xmlRoot.Text = "Новое значение для узла"
[/vba]




Сообщение отредактировал doober - Воскресенье, 10.10.2021, 14:27
 
Ответить
СообщениеЗдравствуйте.[vba]
Код
xmlRoot.Attributes.getNamedItem("ID").Text = "Новое значение для атрибута"
xmlRoot.Text = "Новое значение для узла"
[/vba]

Автор - doober
Дата добавления - 10.10.2021 в 14:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » VBA + XML: Изменение аттрибута узла xml (?) (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!