ListView 数据导出到EXCEL 中；示例如下：

参数：ListView 对象、是否打印、题头

Public Sub GetExcel(ByVal lvwComm As ListView, ByVal isprint As Boolean, ByVal strTitle As String)

    Dim i     As Integer, j       As Integer, c As Integer
    Dim myexcel     As New Excel.Application
    Dim mybook     As New Excel.Workbook
    Dim mysheet     As New Excel.Worksheet
    Set mybook = myexcel.Workbooks.Add
    Set mysheet = mybook.Worksheets.Add
    Dim item As ListItem
    Dim subItem As ListSubItem
    Dim cuCell As String
    On Error Resume Next
    err.number = 0
    '添加标题
    myexcel.Range("A1:" & "k1").Select
    myexcel.Selection.HorizontalAlignment = xlCenter
    myexcel.Selection.Font.Name = "隶书"
    myexcel.Selection.Font.Size = 16
    myexcel.Selection.Merge
    myexcel.ActiveCell.FormulaR1C1 = strTitle
   
    myexcel.Range("A2:" & "k2").Select
    myexcel.Selection.HorizontalAlignment = xlLeft
    myexcel.Selection.ColumnWidth = 10
   
    '添加表头
    For j = 1 To lvwComm.ColumnHeaders.Count
   
        '将listview列标头写入单元格A2-k2
        If j >= 27 Then
            myexcel.Range("A" & Chr(64 + j - 26) & "2").Select
        Else
            myexcel.Range(Chr(64 + j) & "2").Select
        End If
        myexcel.ActiveCell.FormulaR1C1 = lvwComm.ColumnHeaders(j).Text
        myexcel.ActiveCell.Font.Bold = True
   
    Next j
   
    i = 2
    For Each item In lvwComm.ListItems
   
        i = i + 1               '从第三行开始
        DoEvents
       
        '
        c = 0
        'For Each subItem In item.ListSubItems
        For c = 0 To item.ListSubItems.Count  'j - 1
       
            cuCell = UCase$(Chr(65 + c)) & CStr(i)
            If c >= 26 Then cuCell = "A" & UCase$(Chr(65 + c - 26)) & CStr(i)
           
            myexcel.Range(cuCell).Select
            myexcel.Selection.HorizontalAlignment = xlLeft
            If c = 0 Then
                myexcel.ActiveCell.FormulaR1C1 = item.Text & ""
            Else
                myexcel.ActiveCell.FormulaR1C1 = item.SubItems(c) & ""
            End If
           
        Next c
   
    Next
   
    myexcel.Visible = True
    myexcel.DisplayAlerts = False
  
    If isprint = False Then
        'mysheet.PrintPreview
        myexcel.ActiveWindow.SelectedSheets.PrintPreview
    Else
        myexcel.ActiveWindow.SelectedSheets.PrintOut
        myexcel.Visible = False
        myexcel.DisplayAlerts = False
        myexcel.Quit
    End If
 
    If err.number > 0 Then
        MsgBox "本功能需要安装EXCEL支持！", vbInformation
    End If
   
    Set myexcel = Nothing
    Set mybook = Nothing
    Set mysheet = Nothing
End Sub