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

[tianhao123]

最好给个例子！

[SoHo_Andy]

'将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

[Kain]

mark