vb导出为Execle表格

vb导出为Execle表格,第1张

概述 有多种方法。 我用了两种方法。 第一种: 自定义一个过程,直接调用就行。这种方法是直接导出,再保存。   Public Sub TOexcel() '导出数据到excel ' Dim myflexgrid As MSHFlexGrid On Error Resume Next Dim oExcel As Excel.Application Dim obook

有多种方法。

我用了两种方法。

第一种:

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

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表格所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。

欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/langs/1291547.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2022-06-10
下一篇 2022-06-10

发表评论

登录后才能评论

评论列表(0条)

保存