excel 导出

Private Function ExportExcel() As Long
Dim strFileName As String
Dim i As Long, j As Long
Dim xlbook As Excel.Workbook
Dim xlapp As Excel.Application
Dim xlsheet As Excel.Worksheet
On Error GoTo ErrorHandle:
CommonDialog1.FileName = ""
CommonDialog1.Filter = "Excel文件(xls)|*.xls"
CommonDialog1.ShowSave
Screen.MousePointer = 11
strFileName = CommonDialog1.FileName
If strFileName = "" Then
ExportExcel = -1
Exit Function
Else
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = False
xlapp.Workbooks.Add
xlapp.Workbooks(1).SaveAs strFileName
Set xlbook = xlapp.Workbooks.Open(strFileName)
Set xlsheet = xlbook.Worksheets(1)
xlsheet.Name = frmDetail.Caption
For j = 2 To grid.Rows - 1
For i = 1 To grid.Cols - 1
With xlsheet
.Cells(j, i).value = grid.Cell(j, i).Text
.Cells(j, i).Font.Color = grid.Cell(j, i).ForeColor
.Cells(j, i).Font.Bold = grid.Cell(j, i).Font.Bold
.Cells(j, i).Font.Size = grid.Cell(j, i).Font.Size
.Cells(j, i).Interior.Color = grid.Cell(j, i).BackColor
.Cells(j, i).Border = grid.Cell(j, i).Border
End With
Next i
Next j
ExportExcel = 1
End If
xlbook.Save
xlbook.Close
xlapp.Quit
If Not (xlbook Is Nothing) Then
Set xlbook = Nothing
End If
If Not (xlsheet Is Nothing) Then
Set xlsheet = Nothing
End If
If Not (xlapp Is Nothing) Then
Set xlapp = Nothing
End If
Screen.MousePointer = 0
Exit Function
ErrorHandle:
xlbook.Close
xlapp.Quit
Screen.MousePointer = 0
ExportExcel = -1
MsgBox Err.Description
End Function