'請你自己加個CommonDialog控件
Private Sub Command3_Click()
Dim objFileSystem As Object
Dim objExcelText As Object
Dim strTableString As String, i As Integer, strFileName As String
Dim pubConn As New ADODB.Connection
Dim rsTable As New ADODB.Recordset
Dim strConn As String
Dim strSQL As String
Private Function CheckExcel() As Boolean
Dim oExcel As Object
On Error GoTo errHandle
CheckExcel = False
Set oExcel = CreateObject("Excel.Application")
If Val(oExcel.Version) < 7 Then
Err.Raise vbObjectError
Else
CheckExcel = True
End If
Set oExcel = Nothing
Exit Function
errHandle:
Set oExcel = Nothing
Err.Clear
MsgBox "请确认在本机已经安装了Microsoft Excel 97或以上版本", vbOKOnly + vbCritical, "系统提示"
End Function
Public Sub ListViewExportToExcel(lv As ListView, Optional ByVal psTitle As String, Optional ByVal pbShow As Boolean = True)
Dim oExcel As Object
Dim oSheet As Object
Dim iRowCount As Integer
Dim i As Integer, k As Integer
If CheckExcel = False Then Exit Sub
On Error GoTo errHandle
Set oExcel = CreateObject("Excel.Application")
Call oExcel.Workbooks.Add
Set oSheet = oExcel.Sheets(1)
If pbShow = True Then
oExcel.Visible = True
End If
'生成标题
iRowCount = 1
If Trim(psTitle) <> "" Then
oSheet.Cells(iRowCount, 1) = psTitle
End If
'合并居中
With oSheet
.Range(.Cells(iRowCount, 1), .Cells(iRowCount, lv.ColumnHeaders.Count)).Merge '这儿要改报表的栏位数
.Range(.Cells(iRowCount, 1), .Cells(iRowCount, 1)).HorizontalAlignment = xlCenter '-4108
End With
'生成列标题
iRowCount = iRowCount + 1
For i = 1 To lv.ColumnHeaders.Count
oSheet.Cells(iRowCount, i) = lv.ColumnHeaders.Item(i).Text
Next i
'画表格线
If lv.ListItems.Count > 0 Then
With oSheet.Range(oSheet.Cells(iRowCount, 1), oSheet.Cells(iRowCount + lv.ListItems.Count, lv.ColumnHeaders.Count)) '这儿要改报表的栏位数
.Borders(xlDiagonalDown).LineStyle = xlNone '-4142
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlContinuous '1
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
End If
'生成内容
iRowCount = iRowCount + 1
For i = 1 To lv.ListItems.Count
oSheet.Cells(iRowCount, 1) = lv.ListItems.Item(i).Text
For k = 1 To lv.ColumnHeaders.Count - 1
oSheet.Cells(iRowCount, k + 1) = lv.ListItems.Item(i).SubItems(k)
Next k
iRowCount = iRowCount + 1
Next i
'显示
oExcel.Visible = True
Set oExcel = Nothing
Exit Sub
errHandle:
oExcel.Visible = True
Set oExcel = Nothing
Call RaiseError("ClsExportToExcel.ListViewExportToExcel")
End Sub