【 tulaoshi.com - ASP.NET 】
                             
                             工程引用说明:本代码的使用是基于Microsoft Excel 2003使用的,未在其它版本的Office上测试过,因此在VB中应当引用Microsoft Excel 11.0
代码其它内容说明:本代码中使用了VsFlexGrid做为源数据;并且可以命名EXCEL 工作单(SHEET)的名称,其中第一段代码是将内容保存到一个新的EXCEL 工作簿中,而第二个则是将内容保存到一个已存在的工作簿中。
为了显示进度,我使用了一个显示进度的窗体,frmPBar,可以去掉相关的该段代码。
Public Sub GridToExcel(srcGrid As VSFlexGrid, shName As String)
 '将Grid中的数据导出到Excel表格中
 Dim i As Integer
 Dim j As Integer 
 Dim appXL As Variant
 Dim wb As Excel.Workbook
 Dim sh As Excel.Worksheet
 Dim rng, rng1, rng2 As Excel.Range 
 On Error GoTo errhandler 
 Set appXL = CreateObject("Excel.Application")
 Set wb = appXL.Workbooks.Add() 
 wb.Activate 
 Set sh = wb.Worksheets.Add()
 sh.Name = shName 
 frmPBar.Caption = "正在导出数据,请稍候......"
 frmPBar.Show 
 For i = 0 To src/DownloadFilesa2005-02-15/DownloadFilesa2005-02-15Grid.Rows - 1
 For j = 1 To src/DownloadFilesa2005-02-15/DownloadFilesa2005-02-15Grid.Cols - 1
 sh.Cells(i + 1, j) = src/DownloadFilesa2005-02-15/DownloadFilesa2005-02-15Grid.Cell(flexcpText, i, j)
 DoEvents
 Next j
 Next i 
 Unload frmPBar 
 appXL.Visible = True
 Exit Sub
errhandler:
 MsgBox Err.Description 
End Sub
Public Sub GridToExistExcel(srcGrid As VSFlexGrid, fileName As String, shName As String)
 '将Grid中的数据导出到一个指定文件的Excel表格中
 Dim i As Integer
 Dim j As Integer 
 Dim appXL As Variant
 Dim wb As Excel.Workbook
 Dim sh As Excel.Worksheet
 Dim rng, rng1, rng2 As Excel.Range 
 On Error GoTo errhandler 
 Set appXL = CreateObject("Excel.Application")
 'Set wb = appXL.Workbooks.Add()
 Set wb = appXL.Workbooks.Open(fileName)
 wb.Activate 
 Set sh = wb.Worksheets.Add()
 sh.Name = shName 
 frmPBar.Caption = "正在导出数据,请稍候......"
 frmPBar.Show
 For i = 0 To src/DownloadFilesa2005-02-15/DownloadFilesa2005-02-15Grid.Rows - 1
 For j = 1 To src/DownloadFilesa2005-02-15/DownloadFilesa2005-02-15Grid.Cols - 1
 sh.Cells(i + 1, j) = src/DownloadFilesa2005-02-15/DownloadFilesa2005-02-15Grid.Cell(flexcpText, i, j)
 DoEvents
 Next j
 Next i
 Unload frmPBar 
 appXL.Visible = True
 Exit Sub
errhandler:
 MsgBox Err.Description 
End Sub