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, ""     Print #1, ""

    '循环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, "    "             For c = 2 To Rng.Columns.Count                 '判断Excel中当前行的下一列是否有数据                 If Rng.Cells(r, c) = "" Then                     Rng.Cells(r, c) = 0                 End If                 Print #1, "        ";                 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, ""             Next c             Print #1, "    "         Next r          Next i          Print #1, ""          '关闭     Close #1

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