工程引用说明:本代码的使用是基于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 srcGrid.Rows - 1 For j = 1 To srcGrid.Cols - 1 sh.Cells(i + 1, j) = srcGrid.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 srcGrid.Rows - 1 For j = 1 To srcGrid.Cols - 1 sh.Cells(i + 1, j) = srcGrid.Cell(flexcpText, i, j) DoEvents Next j Next i Unload frmPBar appXL.Visible = True Exit Sub errhandler: MsgBox Err.Description End Sub

|