有多种方法。
我用了两种方法。
第一种:
自定义一个过程,直接调用就行。这种方法是直接导出,再保存。
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 = TrueEnd Sub@H_404_9@
方法二:先选择保存的位置。再进行保存。
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 IfEnd IfErrHandler: Exit SubmyflexgrID.Redraw = False '关闭表格重画,加快运行速度Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象Dim xlBook As New Excel.ApplicationxlApp.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 CNext RmyflexgrID.Redraw = True'xlsheet.PrintOut '打印工作表xlApp.displayAlerts = False '不进行安全提示'xlBook.Close (False) '关闭工作簿'Set xlsheet = nothingSet xlBook = nothingxlApp.QuitSet xlApp = nothing@H_404_9@基础差,加油中!
总结以上是内存溢出为你收集整理的vb导出为Execle表格全部内容,希望文章能够帮你解决vb导出为Execle表格所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)