|
发表于 2013-5-22 14:01
|
显示全部楼层
本楼为最佳答案
本帖最后由 hwc2ycy 于 2013-5-22 15:12 编辑
- Private Sub CommandButton2_Click()
- Dim i As Integer
- Dim j As Integer
- Dim x As Integer
- Dim arr()
- Dim lCount As Long
- On Error GoTo ErrorHandler
- With Me.ListView1
-
- lCount = .ListItems.Count
- If lCount = 0 Then
- MsgBox "列表中无数据可写入工作表"
- Exit Sub
- End If
- ReDim arr(0 To lCount, 1 To .ColumnHeaders.Count)
- For i = 1 To ubound(arr,2)
- arr(0, i) = .ColumnHeaders(i).Text
- Next
- For i = 1 To lCount
- With .ListItems(i)
- arr(i, 1) = .Text
- For j = 2 To UBound(arr, 2)
- arr(i, j) = .SubItems(j - 1)
- Next j
- End With
- Next i
- End With
- With Worksheets("查询结果")
- Application.ScreenUpdating = False
- .Range("a1").CurrentRegion.ClearContents
- .Range("a1").Resize(lCount + 1, UBound(arr, 2)).Value = arr
- Application.ScreenUpdating = True
- End With
- MsgBox "导出完成"
- Exit Sub
- ErrorHandler:
- MsgBox Err.Number & vbCrLf & _
- Err.Description
- End Sub
复制代码 |
|