Создать XML файл из именованных ячеек и их значений

Question

Я хочу создать файл XML из именованных ячеек и их значений в макросе,

, конечная цель - l oop в именованных ячейках, извлечь информацию из имен для создания узлы и их значения для создания других узлов, следуя очень точной структуре

как новичку в VBA Excel. Я попробовал эти фрагменты кода просто для того, чтобы создать столько узлов, сколько имен ячеек на листе, но это не работает

    Sub test2xml()

Dim Doc_XML As Object   'Va nous permettre de créer le XML
Dim Root As Object      '... de créer la racine du XML
Dim Node As Object      '... de créer les noeuds
Dim Name As Object      '... de créer les attributs
Dim Chemin As String    'Chemin de sauvegarde

Set Doc_XML = CreateObject("MSXML2.DOMDocument")    'Création du XML

'Ajout des données d'encodage/etc...
Set Node = Doc_XML.createProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")

Doc_XML.appendChild Node                            'Ajout des données au fichier
Set Node = Nothing                                  'Remise à zéro du noeud
Set Root = Doc_XML.createElement("Root")            'Création d'une racine
Doc_XML.appendChild Root                            'Ajout de la racine au XML


Set Node = Doc_XML.createElement("Child55")             'Création d'un noeud
Root.appendChild Node                               'Ajout du noeud à la racine
Node.Text = "Text 1"                                'Ajout d'un texte dans le noeud

Set Node = Nothing


Dim Plage As Range
Dim Nm As Name

On Error Resume Next
'Boucle sur les noms du classeur
For Each Nm In ThisWorkbook.Names
    Set Plage = Nm.RefersToRange

    If Not Plage Is Nothing Then
        'Vérifie si le nom appartient à la feuille
        If Worksheets("T06").Name = Plage.Worksheet.Name Then _
            Node = Doc_XML.createElement("ValeurCellule")         'Création d'un noeud
            Root.appendChild Node                          'Ajout du noeud à la racine
            Node.Text = Nm.Name
            Set Node = Nothing
    End If

    Set Plage = Nothing
Next Nm


'Sauvegarde
Chemin = ThisWorkbook.Path & "\Nom du Fichier.xml"  'Chemin de sauvegarde + Nom du fichier
Doc_XML.Save Chemin

End Sub

файл XML создан, но создан только первый узел stati c, другие динамики не созданы

заранее спасибо

Answer 1

XML создание

Справка MS по RefersToRange гласит:

Если объект Name не ссылается на диапазон (например, если он ссылается на константу или формулу), это свойство не срабатывает.

Я полагаю, что эти случаи не будут встречаться в вашей структуре xml, поэтому вы должны сделать некоторая обработка ошибок.

Однако проблема заключается не в свойстве RefersToRange, а в простом факте, что вам необходимо Set объектов, например

    Set Node = Doc_XML.createElement(Nm.Name)

Кроме того, я предполагаю, что вы хотите отобразить

• имя ячейки как имя узла (например, <Name1>..</Name1>, а не каждый раз <ValeurCellule>...</ValeurCellule>
• содержимое узла, которое должно быть заполнено содержимое ссылающейся ячейки, а не по имени ячейки

... (если нет, его можно легко изменить обратно, аналогично коду вашего OP, используя повторяющиеся узлы <ValeurCellule>...</ValeurCellule> с именами в качестве содержимого узла)

Дополнительная подсказка: Рекомендую объявить текущую и последнюю версию 6 (с hout version номер объявления по умолчанию верс. 3!), Т.е.

 Set Doc_XML = CreateObject("MSXML2.DOMDocument.6.0")  

Пример кода рядом с вашим постом

Public Sub test2xml()

Dim Doc_XML As Object   'Va nous permettre de créer le XML
Dim Root    As Object   '... de créer la racine du XML
Dim Node    As Object   '... de créer les noeuds
Dim Name    As Object   '... de créer les attributs
Dim Chemin  As String   'xml file path
''Stop
Set Doc_XML = CreateObject("MSXML2.DOMDocument.6.0")    'Création du XML <<version 6.0>>

'Ajout des données d'encodage/etc...
Set Node = Doc_XML.createProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")

Doc_XML.appendChild Node                            'Ajout des données au fichier
'Set Node = Nothing                                  'Remise à zéro du noeud
Set Root = Doc_XML.createElement("Root")            'Création d'une racine
Doc_XML.appendChild Root                            'Ajout de la racine au XML

Set Node = Doc_XML.createElement("Child55")         'Création d'un noeud
Root.appendChild Node                               'Ajout du noeud à la racine
Node.Text = "Text 1"                                'Ajout d'un texte dans le noeud

Dim Plage As Range
Dim Nm As Name
'Loop through workbook names
For Each Nm In ThisWorkbook.Names

    On Error Resume Next
    Set Plage = Nm.RefersToRange
    ' Error handling immediately after the risky property
    If Err.Number = 0 Then
        Debug.Print Nm & " refers to ~> " & Plage.Value     ' display only for testing, omit name + value
    Else
        Debug.Print Nm & " Error No " & Err.Number & "**refers to constant or formula: " & Evaluate(Nm.RefersTo)
    End If

    If Not Plage Is Nothing Then
        'check if correct worksheet name, then >>Set<< Node
        If Worksheets("T06").Name = Plage.Worksheet.Name Then _
            Set Node = Doc_XML.createElement(Nm.Name)      '<~~ Création d'un noeud with the ~> Cell's Name
            Root.appendChild Node                          'Ajout du noeud à la racine
            Node.Text = Plage.Value                        'cell content
    End If
    Set Plage = Nothing
Next Nm

'Save xml file
Chemin = ThisWorkbook.Path & "\xml\Nom du Fichier.xml"  'Chemin de sauvegarde + Nom du fichier
Doc_XML.Save Chemin                                     'save xml file

'Debug.Print Doc_XML.XML                                ' optional display in immediate window
End Sub