Excle使用VBA导出为XML格式

Private Sub ToXML()

    '定义所需类型
    Dim Filename As Variant
    Dim TDOpenTag As String
    Dim CellContents As String
    Dim Rng As Range
    Dim r As Long, c As Integer

    '定义保存名称和类型
    Filename = Application.GetSaveAsFilename( _
    InitialFileName:="ButtonTextList.xml", _
    fileFilter:="XML Files(*.xml), *.xml")
    If Filename = False Then Exit Sub

    '定义输出缩写
    Open Filename For Output As #1

    Print #1, "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>"
    Print #1, "<BUFF模板表  xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"

    '循环sheets
    For i = 1 To 1
        
        '设置单元格范围
        Set Rng = Worksheets(i).Range("A1:AN1000")
        
        For r = 2 To Rng.Rows.Count
            ' 判断Excel中下一行是否有数据
            If Rng.Cells(r, 1) = "" Then
                Exit For
            End If
            Print #1, "    <" & Rng.Cells(r, 1) & ">"
            For c = 2 To Rng.Columns.Count
                '判断Excel中当前行的下一列是否有数据
                If Rng.Cells(r, c) = "" Then
                    Rng.Cells(r, c) = 0
                End If
                Print #1, "        <" & Rng.Cells(1, c) & ">";
                If IsDate(Rng.Cells(r, c)) Then
                    Print #1, Format(Rng.Cells(r, c), "yyyy-mm-dd");
                Else
                    Print #1, Rng.Cells(r, c).Text;
                End If
                Print #1, "</" & Rng.Cells(1, c) & ">"
            Next c
            Print #1, "    </" & Rng.Cells(r, 1) & ">"
        Next r
    
    Next i
    
    Print #1, "</BUFF模板表>"
    
    '关闭
    Close #1

    '保存
    MsgBox Rng.Rows.Count - 1 & " records were exported to " & Filename
    
End Sub