有多种方法。
我用了两种方法。
第一种:
自定义一个过程,直接调用就行。这种方法是直接导出,再保存。
Public Sub TOexcel() '导出数据到excel
' Dim myflexgrid As MSHFlexGrid
On Error Resume Next
Dim oExcel As Excel.Application
Dim obook As Excel.Workbook
Dim objExlSht As Excel.Worksheet
Dim listrst() As Variant
Dim X, Y As Long
Dim i, n As Integer
Set oExcel = New Excel.Application
Set obook = oExcel.Workbooks.Add
Set objExlSht = obook.ActiveSheet
X = myflexgrid.Rows
Y = myflexgrid.Cols
ReDim listrst(X, Y)
For i = 0 To myflexgrid.Rows - 1
For n = 0 To myflexgrid.Cols - 1
listrst(i, n) = Trim(myflexgrid.TextMatrix(i, n))
Next
Next
DoEvents
With objExlSht
oExcel.Intersect(.Range(.Rows(1), .Rows(X)), .Range(.Columns(1), .Columns(Y))).Value = listrst
End With
oExcel.Visible = True
oExcel.Interactive = True
End Sub
方法二:
先选择保存的位置。再进行保存。
Dim Txtmodel As TextBox
Dim i, j As Integer
Dim objExlApp As New Excel.Application
Dim objExlBook As New Excel.Workbook
Dim objExlSheet As New Excel.Worksheet
If myflexgrid.Rows > 1 Then
If Not (myflexgrid.Rows = 0 Or myflexgrid.RowSel = 0) Then
'另存到XLS文件
' 设置“取消”为 True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.Filter = "Excel文件(*.xls)|*.xls|所有文件|*.*"
CommonDialog1.FileName = ""
CommonDialog1.ShowSave
objExlApp.Visible = False
objExlApp.DisplayAlerts = False
objExlApp.ScreenUpdating = False
'创建新的工作薄
Set objExlBook = objExlApp.Workbooks.Add
'设置要使用的工作表
Set objExlSheet = objExlBook.Sheets(1)
objExlSheet.Cells(1, 1) = "学生上机记录查询表"
For i = 0 To myflexgrid.Rows - 1
objExlSheet.Cells(i + 3, 1) = myflexgrid.TextMatrix(i, 1)
objExlSheet.Cells(i + 3, 2) = myflexgrid.TextMatrix(i, 2)
objExlSheet.Cells(i + 3, 3) = myflexgrid.TextMatrix(i, 3)
objExlSheet.Cells(i + 3, 4) = myflexgrid.TextMatrix(i, 4)
objExlSheet.Cells(i + 3, 5) = myflexgrid.TextMatrix(i, 5)
objExlSheet.Cells(i + 3, 6) = myflexgrid.TextMatrix(i, 6)
objExlSheet.Cells(i + 3, 7) = myflexgrid.TextMatrix(i, 7)
objExlSheet.Cells(i + 3, 8) = myflexgrid.TextMatrix(i, 8)
Next i
sFileName = CommonDialog1.FileName
objExlSheet.SaveAs sFileName
objExlApp.Visible = True
objExlApp.ScreenUpdating = True
objExlApp.DisplayAlerts = True
objExlApp.Application.Quit
Set objExlSheet = Nothing
Set objExlBook = Nothing
Set objExlApp = Nothing
'objExlBook.Close
MsgBox "文件已保存,在:" & sFileName
Else
MsgBox "没有可导出的数据,请先进行查询!"
End If
End If
ErrHandler:
Exit Sub
myflexgrid.Redraw = False '关闭表格重画,加快运行速度
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Dim xlBook As New Excel.Application
xlApp.Visible = True '设置EXCEL对象可见(或不可见)
Set xlsheet = xlBook.Workbooks("Sheet1") '设置活动工作表
For R = 0 To myflexgrid.Rows - 1 '行循环
For C = 0 To myflexgrid.Cols - 1 '列循环
myflexgrid.row = R
myflexgrid.Col = C
xlBook.Worksheets("Sheet1").Cells(R + 1, C + 1) = myflexgrid.Text '保存到EXCEL
Next C
Next R
myflexgrid.Redraw = True
'xlsheet.PrintOut '打印工作表
xlApp.DisplayAlerts = False '不进行安全提示
'xlBook.Close (False) '关闭工作簿
'Set xlsheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
基础差,加油中!