从命名单元格及其值创建 XML 文件

Question

我想根据宏中的命名单元格及其值创建一个 XML 文件，

最后objective是在命名单元格上循环，从名称中提取信息以创建节点，并通过遵循非常精确的结构从它们的值中提取信息以创建其他节点

作为 VBA 的初学者 Excel 我尝试了这些代码只是为了在 sheet 上创建与单元格名称一样多的节点，但它不起作用

    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表述如下

If the Name object doesn't refer to a range (for example, if it refers to a constant or a formula), this property fails.

我想这些情况不会发生在你的 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")

接近您的代码示例post

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

从命名单元格及其值创建 XML 文件

Create XML file from named cells and their values

xml

excel

vba

xsd

named-ranges