Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称:ExporToExcel
'* 功能:导出数据到EXCEL
'* 用法:ExporToExcel(sql查询字符串)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim IrowCount As Integer
Dim IcolCount As Integer
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    Rs_Data.Open strOpen, adoCN, adOpenStatic, adLockOptimistic
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        IrowCount = .RecordCount
        '字段总数
        IcolCount = .Fields.Count
    End With
    '添加查询语句,导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, IcolCount)).Font.Name = "黑体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, IcolCount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(IrowCount + 1, IcolCount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = NothingEnd Function

解决方案 »

  1.   

    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
        这样速度很快,一秒
       如果往每个CEll里写的话要一分钟
      

  2.   

    连接字符串和打开表你们自己写Rs_Data.Open strOpen, adoCN, adOpenStatic, adLockOptimistic只要是个ADO记录集就行
    引用Microsoft Excel类型库:从"工程"菜单中选择"引用"栏;选择Microsoft Excel 9.0 Object Library;
      

  3.   

    我的错出在这条语句上:
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    说是无效的参数
      

  4.   

    对号入座, lihonggen0的程序没有错
    Dim xlapp As New Excel.Application
    Dim xlbook As New Excel.Workbook
    Dim xlsheet As New Excel.Worksheet
    Dim xlQuery As New Excel.QueryTable
      

  5.   

    回复人: popety_bit(飞) (  ) 信誉:100 装excel 2000 了吗
      

  6.   

    我对xlApp.Visible = True这一句话有点意见,得看情况使用。因为有时导入数据的话,xlApp.Visible = false会速度会快上好几倍的,当然啦有些会影响有些函数或功能不能使用。
      

  7.   

    newyon() 
    你能講講是哪些函數和功能不能用嗎?
      

  8.   

    xlApp.Visible = True 只有在你要看的时候用否则不用
    那要快很多的
      

  9.   

    首先抱歉,請假了一段時間,今天才回來.
    lihonggen0(李洪根,用VB,标准答案来了) :
    你說的是一種比較理想的狀況.
    如果表格裡面每一行的Sql語句都不一樣,或者說必須通過循環來實現的話,你這樣用Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1")好像就部大可能.
    不知我的意思表達清楚了沒有.
      

  10.   

    一.昨天分步執行了我的程序,再次看到幾個速度瓶頸:
    1.創建Excel對象.
    2.頁面設置的一些語句執行.二.如果難以忍受太慢的速度,而打算加ProgressBar的朋友.要注意一點的是:
    如果想在ProgressBar走的時候在旁邊加上一個說明性的Label或者Textbox來顯示程序執行到的地方,一定要在Label或者Textbox賦值語句後加上Me.Refresh.否則你Label或者Textbox裡面的內容不會根據程序執行來發生變化.
      

  11.   

    如果表格裡面每一行的Sql語句都不一樣如果每一行的查询都是从若干个表中提取 , 那只得写cell  ,没有别的办法
      

  12.   

    lihonggen0(李洪根,用VB,标准答案来了) 講的沒錯.
    如果你要顯示的數據必須是通過多個SQL語句來高定的話,就不能像上面的兄弟那麼用了.
    如果可以用循環來實現顯示sql查詢數據的話,可以先將查出來的數據放到自己定義的一個數組中,然後用Range.FormulaArray=定義的數組,就可以填充數據,這樣也比較快
      

  13.   

    (李洪根,用VB,标准答案来了) :
    :你好!
    你在http://www.csdn.net/expert/topic/934/934155.xml?temp=.1925165中留的程序好幾個網友反映不能正常運行,我試了一下,是Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1")),執行不過去.說
    "Run time error '5':Invalid procedure call or argument".
    我的運行環境是:window server2000+Office2000+Sql Server.
    我看到QueryTables.Add的參數是Connection,Range,[Sql].但我無論怎麼修改都還是一樣的錯誤.
    請你幫忙!如果你能回覆我們將非常感謝!
      

  14.   

    试试你的 excel 2000  获取外部数据的功能--->新建数据库查询
    是否可以? 我的程序就相当于这个功能
      

  15.   

    excel 2000  获取外部数据的功能--->新建数据库查询 这功能可以,通过新建数据库查询可以查找到数据,要设ODBC数据接口。但Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))还是不行。