有多种方法。
我用了两种方法。
第一种:
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
基础差,加油中!
原文链接:https://www.f2er.com/vb/260965.html