vb导出为Execle表格

有多种方法。

我用了两种方法。

第一种：

自定义一个过程，直接调用就行。这种方法是直接导出，再保存。

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

基础差，加油中！