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

基础差，加油中！