关于保存excel的问题

Question

各位：
  今天我做了一段程式，做了一个excel表，但是我不会显示出来表的内容和保存表，保存表的函数我也不知道，有人愿意帮我这个忙吗？万分感激！

Answer 1

参考一下我写的代码：
http://topic.csdn.net/u/20080128/22/85f24441-16d0-4fe2-a463-4e7dd73ed652.html
http://topic.csdn.net/u/20080127/16/2a102bc7-ea5d-4f5a-b962-4da424407fdf.html

Answer 2

用WorkBook对象的 .Save 方法就可保存工作薄.

Answer 3

　从"工程"菜单中选择"引用"栏；选择Microsoft Excel 9.0 Object Library（EXCEL2000），然后选择"确定"。表示在工程中要引用EXCEL类型库。
Dim xlApp As Excel.Application
Dim xlBook As Excel.WorkBook
Dim xlSheet As Excel.Worksheet 在程序中操作EXCEL表常用命令：
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Open("文件名") '打开已经存在的EXCEL工件簿文件
xlApp.Visible = True '设置EXCEL对象可见（或不可见）
Set xlSheet = xlBook.Worksheets("表名") '设置活动工作表
xlSheet.Cells(row, col) =值 '给单元格（row,col）赋值
xlSheet.PrintOut '打印工作表
xlBook.Close (True) '关闭工作簿
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象
xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏
xlBook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏 
xlBook.SaveAs vXlsName  '保存为vXlsName  在网上发现的函数，参考一下，很不错的！ 'Write By WeiHua 2000.10.12'检测文件
Function CheckFile(ByVal strFile As String) As Boolean
    Dim FileXls As Object
    Set FileXls = CreateObject("Scripting.FileSystemObject")    If IsNull(strFile) Or strFile = "" Then
        CheckFile = False        Exit Function
    End If    If FileXls.FileExists(strFile) = False Then        CheckFile = False
        Set FileXls = Nothing
        Exit Function
    Else        CheckFile = True
        Set FileXls = Nothing
    End IfEnd Function
'检测工作表
Function CheckSheet(ByVal strSheet As String, ByVal strWorkBook As String, xlCheckApp As Excel.Application) As Boolean
    Dim L As Integer
    Dim CheckWorkBook As Excel.Workbook    If CheckFile(strWorkBook) And strSheet <> "" And Not IsNull(strSheet) Then
        For L = 1 To xlCheckApp.Workbooks.Count
            If GetPath(xlCheckApp.Workbooks(L).Path) & xlCheckApp.Workbooks(L).Name = strWorkBook Then
                Set CheckWorkBook = xlCheckApp.Workbooks(L)
                Exit For
            End If
        Next L        Set CheckWorkBook = xlCheckApp.Workbooks.Open(strWorkBook)
        For L = 1 To CheckWorkBook.Worksheets.Count
            If CheckWorkBook.Worksheets(L).Name = Trim$(strSheet) Then
                CheckSheet = True
                Exit For
            End If
        Next L    Else
        MsgBox "工作表不存在，可能是由文件名或工作表名引起的！"
        CheckSheet = False
    End IfEnd Function'建立工作表
'CreateMethod:1追加
'CreateMethod:2覆盖
Function CreateSheet(ByVal strSheetName As String, ByVal strWorkBook As String, ByVal CreateMethod As Integer, xlCreateApp As Excel.Application) As Boolean
    Dim xlCreateSheet As Excel.Worksheet    If CheckFile(strWorkBook) Then        xlCreateApp.Workbooks.Open (strWorkBook)        If CreateMethod = 1 Then            If CheckSheet(strSheetName, strWorkBook, xlCreateApp) = False Then                Set xlCreateSheet = xlCreateApp.Worksheets.Add
                xlCreateSheet.Name = strSheetName
                xlCreateApp.ActiveWorkbook.Save                CreateSheet = True
                Set xlCreateSheet = Nothing
            Else
                'MsgBox strSheetName & "工作表已存在！"
                CreateSheet = False
                Set xlCreateSheet = Nothing
            End If        ElseIf CreateMethod = 2 Then
            If CheckSheet(strSheetName, strWorkBook, xlCreateApp) = True Then
                Set xlCreateSheet = xlCreateApp.Worksheets(strSheetName)
                xlCreateSheet.Cells.Select
                xlCreateSheet.Cells.Delete
                xlCreateApp.ActiveWorkbook.Save
                CreateSheet = True
                Set xlCreateSheet = Nothing
            Else
                'MsgBox strSheetName & "工作表不存在！"
                CreateSheet = False
                Set xlCreateSheet = Nothing
            End If        End If    End IfEnd Function

Answer 4

'删除工作表
Function DeleteSheet(ByVal strSheetName As String, ByVal strWorkBook As String, xlDeleteApp As Excel.Application) As Boolean
    Dim i As Integer
    Dim xlDeleteSheet As Excel.Worksheet    If CheckFile(strWorkBook) Then        If CheckSheet(strSheetName, strWorkBook, xlDeleteApp) = True Then            xlDeleteApp.Workbooks.Open (strWorkBook)            If xlDeleteApp.Worksheets.Count = 1 Then
                MsgBox "工作薄不能全部删除，" & strSheetName & "是最后一个工作表！"
                DeleteSheet = False
                Exit Function
            End If            xlDeleteApp.Worksheets(strSheetName).Delete            xlDeleteApp.ActiveWorkbook.Save
            DeleteSheet = True
        Else
            DeleteSheet = False
        End If    End IfEnd Function'复制工作表
Function CopySheet(ByVal strSrcSheetName As String, ByVal strSrcWorkBook As String, ByVal strTagSheetName As String, ByVal strTagWorkbook As String, xlCopyApp As Excel.Application) As Boolean
    Dim xlSrcBook As Excel.Workbook
    Dim xlTagBook As Excel.Workbook
    Dim ExcelSource As Excel.Worksheet
    Dim ExcelTarget As Excel.Worksheet
    Dim Result As Boolean    If CheckFile(strSrcWorkBook) = False Or CheckFile(strTagWorkbook) = False Then
        Set ExcelSource = Nothing
        Set ExcelTarget = Nothing
        Set xlSrcBook = Nothing
        Set xlTagBook = Nothing
        CopySheet = False
        Exit Function
    Else        Set xlSrcBook = xlCopyApp.Workbooks.Open(strSrcWorkBook)        If strSrcWorkBook = strTagWorkbook Then
            If strSrcSheetName = strTagSheetName Then
                Set ExcelSource = Nothing
                Set ExcelTarget = Nothing
                Set xlSrcBook = Nothing
                Set xlTagBook = Nothing
                CopySheet = False
                Exit Function
            End If            Set xlTagBook = xlSrcBook
        Else
            Set xlTagBook = xlCopyApp.Workbooks.Open(strTagWorkbook)
        End If        Set ExcelSource = xlSrcBook.Worksheets(strSrcSheetName)
        Set ExcelTarget = xlTagBook.Worksheets(strTagSheetName)        ExcelSource.Select
        ExcelSource.Cells.Copy
        ExcelTarget.Select
        ExcelTarget.Paste
        xlCopyApp.Application.CutCopyMode = xlCopy        If strSrcWorkBook = strTagWorkbook Then
            xlTagBook.Save
            xlSrcBook.Save
        Else
            xlTagBook.Save
        End If        Set ExcelSource = Nothing
        Set ExcelTarget = Nothing
        Set xlSrcBook = Nothing
        Set xlTagBook = Nothing
        CopySheet = True
    End If
End Function
'复制工作表
Function ExcelCopySheet(ByVal strSrcSheetName As String, ByVal strSrcWorkBook As String, ByVal strTagSheetName As String, ByVal strTagWorkbook As String, xlCopyApp As Excel.Application) As Boolean
    Dim xlSrcBook As Excel.Workbook
    Dim xlTagBook As Excel.Workbook
    Dim ExcelSource As Excel.Worksheet
    Dim ExcelTarget As Excel.Worksheet
    Dim Result As Boolean    If CheckFile(strSrcWorkBook) = False Or CheckFile(strTagWorkbook) = False Then
        Set ExcelSource = Nothing
        Set ExcelTarget = Nothing
        Set xlSrcBook = Nothing
        Set xlTagBook = Nothing
        CopySheet = False
        Exit Function
    Else        Set xlSrcBook = xlCopyApp.Workbooks.Open(strSrcWorkBook)        If strSrcWorkBook = strTagWorkbook Then
            If strSrcSheetName = strTagSheetName Then
                Set ExcelSource = Nothing
                Set ExcelTarget = Nothing
                Set xlSrcBook = Nothing
                Set xlTagBook = Nothing
                CopySheet = False
                Exit Function
            End If            Set xlTagBook = xlSrcBook
        Else
            Set xlTagBook = xlCopyApp.Workbooks.Open(strTagWorkbook)
        End If        Set ExcelSource = xlSrcBook.Worksheets(strSrcSheetName)
        Set ExcelTarget = xlTagBook.Worksheets(strTagSheetName)        ExcelSource.Select
        ExcelSource.Copy before
        ExcelTarget.Select
        ExcelTarget.Paste
        xlCopyApp.Application.CutCopyMode = xlCopy        If strSrcWorkBook = strTagWorkbook Then
            xlTagBook.Save
            xlSrcBook.Save
        Else
            xlTagBook.Save
        End If        Set ExcelSource = Nothing
        Set ExcelTarget = Nothing
        Set xlSrcBook = Nothing
        Set xlTagBook = Nothing
        CopySheet = True
    End If
End Function'关闭Excel应用
Function CloseExcelApp(xlApp As Object)
    On Error Resume Next
    xlApp.Quit
    Set xlApp = Nothing
End Function'建立Excel应用
Function CreateExcelApp(QuitApp As Boolean) As Object
    On Error Resume Next
    Dim xlObject As Object
    If CheckExcel Then        Set xlObject = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set xlObject = Nothing
            Set xlObject = CreateObject("Excel.Application")
            CreateExcelApp = xlObject
        Else
            If QuitApp Then
                xlObject.Quit
                Set xlObject = Nothing
                Set xlObject = CreateObject("Excel.Application")
            End If
            CreateExcelApp = xlObject
        End If    End IfEnd Function'检测EXCEL环境
Function CheckExcel() As Boolean
    Dim xlCheckApp As Object
    Set xlCheckApp = CreateObject("Excel.Application")    If xlCheckApp Is Nothing Then
        MsgBox "对不起，系统未检测到EXCEL安装，请重新检查EXCEL是否被正确安装！"
        CheckExcel = False
        xlCheckApp.Quit
        Set xlCheckApp = Nothing
        Exit Function
    Else
        xlCheckApp.Quit
        CheckExcel = True
        Set xlCheckApp = Nothing
    End If
End FunctionFunction CreateWorkBook(ByVal strWorkBook As String, xlApp As Excel.Application)
    Dim xlCreateWorkBook As Excel.Workbook    Set xlCreateWorkBook = xlApp.Workbooks.Add    xlCreateWorkBook.SaveAs (strWorkBook)
End Function
Function GetPath(strPath As String) As String
    GetPath = IIf(Len(strPath) = 3, strPath, strPath & "\")
End Function