首先在VB中添加引用Microsoft Excel 14.0 Object Library。然后找到相应按钮,在过程中添加如下代码:
<pre name="code" class="vb">Private Sub cmdExport_Click() Dim i As Long,j As Long Dim CellsData() As String <span> </span>'定义数组承载数据 'vb中定义excel对象 Dim objApp As Excel.Application Dim objWorkbook As Excel.Workbook Dim objWorksheet As Excel.Worksheet Dim objRange As Excel.Range '构建二维数组,容纳MSHFlexgrid中的内容 ReDim CellsData(1 To myflexgrid.Rows,1 To myflexgrid.Cols) For i = 1 To myflexgrid.Rows For j = 1 To myflexgrid.Cols CellsData(i,j) = myflexgrid.TextMatrix(i - 1,j - 1) Next Next '执行导出到excel中的代码 Set objApp = New Excel.Application <span> </span>'建立xlapp的引用 objApp.ScreenUpdating = False <span> </span>'禁止屏幕刷新 Set objWorkbook = objApp.Workbooks.Add <span> </span>'添加工作簿 Set objWorksheet = objWorkbook.Sheets.Add <span> </span>'添加工作栏 Set objRange = objWorksheet.Range(objWorksheet.Cells(1,1),& _
<span> </span>objWorksheet.Cells(myflexgrid.Rows,myflexgrid.Cols)) objRange.Value = CellsData <span> </span>'excel表中的内容就是数组的内容 objApp.Visible = True <span> </span>'表可见 objApp.ScreenUpdating = True<span> </span>'屏幕可刷新 '销毁二维数组 Erase CellsData Me.SetFocus <span> </span>'窗体获得焦点 MsgBox "导出完毕!",vbOKOnly + vbExclamation,"警告" End Sub
运行后如下: