vb中MSHFlexGrid控件导出到Excel

在vb程序中将控件MSHFlexGrid数据导出到EXCEL 表中，实现数据库查询的备份。

在模块中建立函数函数定义和链接

首先，函数定义和链接

'MSHFlexGrid控件导出到Excel
Public Function ExportFlexDataToExcel(flex As MSHFlexGrid,g_CommonDialog As CommonDialog)
  
    On Error GoTo ErrHandler
    '定义excel对象类型库
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    Dim Rows As Integer,Cols As Integer
    Dim iRow As Integer,hCol As Integer,iCol As Integer
    Dim New_Col As Boolean
    Dim New_Column     As Boolean
            
    g_CommonDialog.CancelError = True
    On Error GoTo ErrHandler
    ' 设置标志
    g_CommonDialog.Flags = cdlOFNHideReadOnly
    ' 设置过滤器
    g_CommonDialog.Filter = "All Files (*.*)|*.*|Excel Files" & _
    "(*.xls)|*.xls|Batch Files (*.bat)|*.bat"
    ' 指定缺省的过滤器
    g_CommonDialog.FilterIndex = 2
    ' 显示“打开”对话框
    g_CommonDialog.ShowSave
            
    If flex.Rows <= 1 Then    '判断表中是否有数据
        MsgBox "没有数据！",vbInformation,"警告"
        Exit Function
    End If
                    
    Set xlApp = CreateObject("Excel.Application") '链接excel应用程序
    Set xlBook = xlApp.Workbooks.Add '链接工作簿
    xlApp.Visible = True

    With flex    '设置MSHFlexGrid控件与excel程序衔接的方式
        Rows = .Rows
        Cols = .Cols
        iRow = 0
        iCol = 1
        For hCol = 0 To Cols - 1
            For iRow = 1 To Rows
                xlApp.Cells(iRow,iCol).Value = .TextMatrix(iRow - 1,hCol)
            Next iRow
            iCol = iCol + 1
        Next hCol
    End With

其次，在函数中设置excel的个性化设置

 With xlApp         '设置excel格式
        .Rows(1).Font.Bold = True
        .Cells.Select
        .Columns.AutoFit
        .Cells(1,1).Select
'        .Application.Visible = True
    End With
    
    xlBook.SaveAs (g_CommonDialog.FileName) '保存excel表
    xlApp.Application.Visible = True
    xlApp.DisplayAlerts = True

然后，释放excel程序以及函数的错误处理

 'xlApp.Quit
    Set xlApp = Nothing  '"交还控制给Excel释放excel对象
    Set xlBook = Nothing
    flex.SetFocus
    MsgBox "数据已经导出到Excel中。","成功"
    Exit Function
                
ErrHandler:
    ' 用户按了“取消”按钮
    If Err.Number <> 32755 Then
        MsgBox "数据导出失败！",vbCritical,"警告"
    End If
End Function

在窗体中调用函数

Private Sub cmdToExcel_Click()
ExportFlexDataToExcel myflexgrid,cdlSelectExcel  'myflexgrid1为MSHFlexGrid控件名  cdlSelectExcel为commonDialog控件名
End Sub