高分求：如何将listview表格中的内容导出到EXCEL2000文件中？

Question

最好给个例子！

Answer 1

'将listView中的数据导出到Excel的例子
'希望对你有帮助Private Sub PrintToExcel()
On Error GoTo ErrTrap
    Dim xlsApp As New Excel.Application    Dim xlsBook As New Excel.Workbook
    Dim xlsSheet As New Excel.Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim xlsRow As Integer
    Dim xlsCol As Integer
    
    xlsCol = lsvShow.ColumnHeaders.Count - 3
    xlsRow = 3
    
    Set xlsBook = xlsApp.Workbooks.Add
    Set xlsSheet = xlsBook.Worksheets(1)
    xlsSheet.PageSetup.Orientation = xlLandscape     '横向打印
    frm_Wait.Show
    
    xlsApp.Columns(1).NumberFormatLocal = "@"
    '写入列名
    For i = 1 To lsvShow.ColumnHeaders.Count - 3
        xlsApp.Cells(xlsRow, i) = " " & Trim(lsvShow.ColumnHeaders(i).Text)
        xlsApp.Columns(i).Select
        xlsApp.Selection.ColumnWidth = lsvShow.ColumnHeaders(i).Width / 100
    Next i
    'xlsApp.Columns(1).AutoFit
    xlsRow = xlsRow + 1
    '写入列表内容
    For i = 1 To lsvShow.ListItems.Count
        xlsApp.Cells(xlsRow, 1) = Trim(lsvShow.ListItems(i).Text)
        For j = 1 To lsvShow.ColumnHeaders.Count - 4
            xlsApp.Cells(xlsRow, j + 1) = Trim(lsvShow.ListItems(i).SubItems(j))
            xlsApp.Cells(xlsRow, j + 1).WrapText = True
        Next j
        xlsRow = xlsRow + 1
    Next i
    
    '写入标题和时间
    xlsApp.Range(xlsApp.Cells(1, 1), xlsApp.Cells(1, xlsCol)).Select
    With xlsApp.Selection
        .MergeCells = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    xlsApp.Cells(1, 1) = labKeyName.Caption
    xlsApp.Cells(1, 1).Font.Size = 24
    xlsApp.Cells(1, 1).Font.Bold = True
    xlsApp.Cells(2, 1) = "打印时间：" & Date
    
    '设置边框
    xlsApp.Range(xlsApp.Cells(3, 1), xlsApp.Cells(xlsRow, xlsCol)).Select
    With xlsApp.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With xlsApp.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlsApp.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlsApp.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With xlsApp.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With xlsApp.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    xlsApp.Visible = True
    frm_Wait.Visible = False
    Call VBA.AppActivate(xlsBook.Name)
    
    On Error GoTo 0
    Exit Sub
ErrTrap:
    On Error GoTo 0
End Sub