各位先人
请给个实例或相关贴子
本人比较菜 最好是易懂点的

我比代码你:
Dim xlapp As Object '定义EXCEL类
Dim xlbook As Object '定义工件簿类
Dim xlsheet As Object '定义工作表类
Dim N As Integer
Screen.MousePointer = vbHourglass
Sjdf.Show
Sjdf.Label1.Caption = "正在导出数据，请稍后．．．"
Dim i As Long, j As Long, k As Long
If SFileName = "" Then
GridToExcel = False
Exit Function
End If
On Error GoTo err:
Set xlapp = CreateObject("Excel.Application")
If err Then
MsgBox "您的系统没有安装Execl文档！！！", 0 + 48, "提示"
Exit Function
End If
Set xlbook = CreateObject("Excel.Sheet")
Set xlbook = xlapp.Workbooks.Add 'Open(SFileName)
xlapp.Visible = False
Set xlsheet = xlbook.Worksheets(1) '设置sheet1,2,3项

DGrid.Scroll 0, -DGrid.FirstRow '定位到第一行
DGrid.row = 0
For k = 0 To DGrid.Columns.Count - 1 'DataGrid所有的列数
xlsheet.Cells(1, k + 1) = Trim(DGrid.Columns(k).Caption) '第一行为DataGrid的列标题
Next
Sjdf.PBar1.Max = DGrid.ApproxCount '进度条最大值不能等于0
For i = 0 To DGrid.ApproxCount - 1 'DataGrid的所有行数
DoEvents
For j = 0 To DGrid.Columns.Count - 1
If DGrid.Columns(0).Text = "" And i = 0 Then
Screen.MousePointer = vbDefault
Unload Sjdf
GoTo Dispose:
Else
xlsheet.Cells(i + 2, j + 1) = DGrid.Columns(j).Text '从第二行显示'DataGrid的内容
End If
Next j
If Sh = "opf" Or Si = "ipf" Then
If Oxls = True Then
If DGrid.ApproxCount < 16 Then
N = DGrid.ApproxCount - 1
Else
N = DGrid.ApproxCount
End If
Else
N = DGrid.ApproxCount - 1
End If
Else
N = DGrid.ApproxCount - 1
End If
If i < N Then
DGrid.row = DGrid.row + 1
End If
Sjdf.PBar1.value = i
Next i
DGrid.Scroll 0, -DGrid.FirstRow '定位到第一行
Screen.MousePointer = vbDefault
Unload Sjdf
MsgBox "数据导出完毕！", vbOKOnly + 48, "提示"
xlbook.SaveAs (SFileName)
GridToExcel = True
GoTo Dispose:
err:
Screen.MousePointer = vbDefault
MsgBox "存为EXCEL文件时出错！未能导出数据。", vbOKOnly + 48, "提示"
Unload Sjdf
GridToExcel = False
GoTo Dispose:
Dispose:
xlbook.Saved = True
xlbook.Close
xlapp.Quit
Set xlapp = Nothing
Set xlbook = Nothing

谢谢了