根据命名单元及其值创建XML文件

Question

我想从命名的单元格及其宏中的值创建XML文件，

最终目标是循环使用命名的单元格，从名称中提取信息以创建节点及其值，并通过遵循非常精确的结构来创建其他节点

作为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文件，但仅创建了第一个静态节点，未创建其他动态

先谢谢您

Answer 1

XML创建

MS Help to RefersToRange状态如下

如果Name对象没有引用范围（例如，如果它引用常量或公式），则此属性将失败。

我想这些情况不会在您的xml结构中发生，所以您必须进行一些错误处理。

然而，实际的问题不是RefersToRange属性，而是一个简单的事实，即您必须

Set

对象，例如 Set Node = Doc_XML.createElement(Nm.Name)

此外，我假设您想显示

单元名称作为节点名称（例如<Name1>..</Name1>，而不是每次<ValeurCellule>...</ValeurCellule>]
• 将由引用单元格的内容而不是单元格名称填充的节点内容

...（如果不是这样，可以使用名称为节点内容的重复<ValeurCellule>...</ValeurCellule>节点轻松更改回类似于OP的代码）

其他提示：

我建议声明当前和最新版本6（没有版本号，声明默认为版本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