MSHFLexgrid极速导入EXCEL

一、建模块
Public Sub ExportToExcelFast(objGrid As MSHFlexGrid, Optional TextCols As String = "")
Dim xlApp As Object, xlBook As Object, xlSheet As Object
Dim arrData() As String
Dim i As Long, j As Long
Dim strFileName As String

' 创建保存对话框
With cx.CommonDialog1   ''''' 注意窗体名称要对应 ，假设窗体上已放置CommonDialog控件
    .DialogTitle = "保存Excel文件"
    .Filter = "Excel文件 (*.xls)|*.xls"
    .DefaultExt = "xls"
    .FileName = "导出数据.xls"
    .Flags = cdlOFNHideReadOnly + cdlOFNOverwritePrompt
    .ShowSave
    If Len(.FileName) = 0 Then Exit Sub ' 取消操作
    strFileName = .FileName
End With

On Error GoTo ErrorHandler

' 创建Excel object
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)

' 数据转数组（速度优化）
ReDim arrData(1 To objGrid.Rows, 1 To objGrid.Cols)
For i = 0 To objGrid.Rows - 1
    For j = 0 To objGrid.Cols - 1
        arrData(i + 1, j + 1) = objGrid.TextMatrix(i, j)
    Next j
Next i

' 批量写入Excel
xlSheet.Range("A1").Resize(objGrid.Rows, objGrid.Cols).Value = arrData

' 设置文本格式列（防科学计数）
If TextCols <> "" Then
    Dim arrCols() As String
    arrCols = Split(TextCols, ",")
    For i = 0 To UBound(arrCols)
        If IsNumeric(arrCols(i)) Then
            xlSheet.Columns(CLng(arrCols(i))).NumberFormat = "@"
        End If
    Next i
End If

' 在保存前添加（需放在SaveAs之前）
xlSheet.Columns.AutoFit
xlSheet.Rows(1).Font.Bold = True  '''' 粗标题

' 保存并显示Excel
xlBook.SaveAs strFileName
xlApp.Visible = True ' 可选：自动打开文件

Cleanup:
' 释放object1资源
If Not xlSheet Is Nothing Then Set xlSheet = Nothing
If Not xlBook Is Nothing Then Set xlBook = Nothing
If Not xlApp Is Nothing Then
xlApp.Quit
Set xlApp = Nothing
End If
Exit Sub

ErrorHandler:
MsgBox "导出失败：" & Err.Description, vbCritical
Resume Cleanup
End Sub

二、VB窗体上添加 Microsoft Common Dialog Control 控件：
右键工具箱 → 部件 → 勾选 "Microsoft Common Dialog Control 6.0"

三、
' 在Form_Load事件中初始化（可选）
Private Sub Form_Load()
CommonDialog1.InitDir = "C:" ' 设置初始目录
End Sub

四、调用
Private Sub cmdExport_Click()
' 假设CommonDialog控件名为CommonDialog1 ' 导出第2列为文本格式（条码列）
Dim StartTime As Double
' 记录开始时间
StartTime = Timer
ExportToExcelFast MSHFlexGrid1, "2"
MsgBox "导出成功！耗时 " & Round(Timer - StartTime, 2) & " 秒。", vbInformation
End Sub