VBA编写Ribbon Custom UI编辑器05——转换结构体XML

Public Function XML2Array(tXML As XML) As String()
    Dim arr() As String
    Dim pcol As Long
    '记录属性所在的列
    Dim h As CHash
    '注意：这里应该先遍历一次，获取所有不重复属性名称的个数的
    Set h = NewCHash(200)
    h.Add "XMLName", 0
    h.Add "HasChild", 1
    
    Dim i As Long, j As Long
    '计算列的数量
    '第0个是不存在的根节点
    For i = 0 + 1 To tXML.nNode - 1
        For j = 0 To tXML.Nodes(i).AttriNum - 1
            If Not h.Exists(tXML.Nodes(i).Attris(j).Key) Then
                h.Add tXML.Nodes(i).Attris(j).Key, h.Count
            End If
        Next
    Next
    ReDim arr(tXML.nNode, h.Count - 1) As String
    arr(0, 0) = "xmlItem"
    arr(0, 1) = "HasChild"
    
    '开始转换
    For i = 0 + 1 To tXML.nNode - 1
        arr(i, 0) = tXML.Nodes(i).XMLItem
        arr(i, 1) = VBA.CStr(tXML.Nodes(i).HasChild)
        
        For j = 0 To tXML.Nodes(i).AttriNum - 1
            pcol = VBA.CLng(h.GetItem(tXML.Nodes(i).Attris(j).Key))
            arr(0, pcol) = tXML.Nodes(i).Attris(j).Key
            arr(i, pcol) = tXML.Nodes(i).Attris(j).value
        Next
    Next
    XML2Array = arr
    
    Set h = Nothing
End Function

'Arr        从Excel单元格读取的数组
Public Function Array2XMLString(arr()) As String
    Dim rows As Long
    Dim cols As Long
    Dim result() As String
    Dim value As String
    Dim tmp() As String
    
    rows = UBound(arr, 1)
    cols = UBound(arr, 2)
    
    ReDim result(rows - 1 - 1) As String '第一行是标题
    ReDim tmp(cols - 1) As String '记录属性的值，HasChild在B列，是不需要的，多出的一个最后放“>”
    
    Dim i As Long
    Dim j As Long
    Dim iLevel As Long
    Dim bHasChild As Boolean
    
    For i = 2 To rows
        tmp(0) = "<" & VBA.CStr(arr(i, 1)) 'xmlItem
        '/*这种表示的是一个具有子元素的元素的结束
        If VBA.Left$(VBA.CStr(arr(i, 1)), 1) = "/" Then iLevel = iLevel - 1
        
        'HasChild
        bHasChild = VBA.CBool(arr(i, 2))
        If bHasChild Then
            tmp(cols - 1) = ">"
        Else
            If VBA.Left$(VBA.CStr(arr(i, 1)), 1) = "/" Then
                tmp(cols - 1) = ">" & vbNewLine
            Else
                tmp(cols - 1) = "/>"
            End If
        End If
        
        For j = 3 To cols
            value = VBA.CStr(arr(i, j))
            '不为空的时候设置属性值
            If VBA.Len(value) Then
                tmp(j - 2) = " " & VBA.CStr(arr(1, j)) & "=""" & value & """"
            Else
                tmp(j - 2) = ""
            End If
        Next
        
        result(i - 2) = VBA.Space$(iLevel) & VBA.Join(tmp, "")
        
        If bHasChild Then iLevel = iLevel + 1
    Next
    
    Array2XMLString = VBA.Join(result, vbNewLine)
End Function