dcount107大哥；我用你给的那个贴子上的代码写；怎么数据写不到Excel中啊？代码如下（帮我看下）：On Error Resume Next

Dim irow, icol

Dim xlApp 'As Excel.Application

Dim xlBook 'As Excel.Workbook

Dim xlSheet 'As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")

Set xlBook = xlApp.Workbooks.Add

Set xlSheet = xlBook.Worksheets(1)

Dim ListView1

Set ListView1=ScreenItems("ListTable")

With ListView1

If MsgBox("您真的要将资料导出到EXCEL中吗？", vbExclamation + vbYesNo, "警告") = vbYes Then

If .ListItems.Count > 0 Then

MsgBox "确定导入Excel吗？"

xlSheet.Cells(1, 2) = " 三角阀密封性检测数据Excel报表"

xlApp.Range("A1:H1").MergeCells = True

xlApp.Range("A1:H1").HorizontalAlignment = xlCenter

xlSheet.Columns(1).ColumnWidth = 18
xlSheet.Columns(2).ColumnWidth = 18
xlSheet.Columns(3).ColumnWidth = 18
xlSheet.Columns(4).ColumnWidth = 18
xlSheet.Columns(5).ColumnWidth = 18
xlSheet.Columns(6).ColumnWidth = 18
xlSheet.Columns(7).ColumnWidth = 18
xlSheet.Columns(8).ColumnWidth = 18

xlSheet.Cells(2, 1) = "ID"

xlSheet.Cells(2, 2) = "测试序列号"

xlSheet.Cells(2, 3) = "产品序列号"

xlSheet.Cells(2, 4) = "测试状态"

xlSheet.Cells(2, 5) = "初始压力"

xlSheet.Cells(2, 6) = "终止压力"

xlSheet.Cells(2, 7) = "错误代码"

xlSheet.Cells(2, 8) = "测试时间"

For Each oItem In ListView1.ListItems

irow = irow + 1

xlSheet.Cells(irow + 2, 1).Value = oItem

xlSheet.Cells(irow + 2, 2).Value = oItem.SubItems(1)

xlSheet.Cells(irow + 2, 3).Value = oItem.SubItems(2)

xlSheet.Cells(irow + 2, 4).Value = oItem.SubItems(3)

xlSheet.Cells(irow + 2, 5).Value = oItem.SubItems(4)

xlSheet.Cells(irow + 2, 6).Value = oItem.SubItems(5)

xlSheet.Cells(irow + 2, 7).Value = oItem.SubItems(6)

xlSheet.Cells(irow + 2, 8).Value = oItem.SubItems(7)

Next



xlApp.Range("A2:H2").Columns.Interior.ColorIndex = 40

xlApp.Range("A2:H2").Borders.LineStyle = xlContinuous

xlApp.Visible = True

xlApp.Range(xlSheet.Cells(2 + ListView1.ListItems.Count + 1, 1), xlSheet.Cells(2 + ListView1.ListItems.Count + 1, 4)).Columns.Interior.ColorIndex = 40

xlApp.Range(xlSheet.Cells(2 + ListView1.ListItems.Count + 1, 1), xlSheet.Cells(2 + ListView1.ListItems.Count + 1, 4)).Borders.LineStyle = xlContinuous

Else

MsgBox "无数据", vbExclamation + vbOKOnly, "警告"

End If

'Else

End If

'xlApp.QUIT

Set xlApp = Nothing '交还控制给Excel

Set xlBook = Nothing

Set xlSheet = Nothing

End With