一、建模块
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对象
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:
' 释放对象资源
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列为文本格式（条码列）
ExportToExcelFast MSHFlexGrid1, "2"
MsgBox "导出成功！耗时 " & Round(Timer - StartTime, 2) & " 秒。", vbInformation
End Sub
