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

基础差，加油中！

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!