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
'*********************************************************
'* 名称: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
这样速度很快,一秒
如果往每个CEll里写的话要一分钟
引用Microsoft Excel类型库:从"工程"菜单中选择"引用"栏;选择Microsoft Excel 9.0 Object Library;
Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
说是无效的参数
Dim xlapp As New Excel.Application
Dim xlbook As New Excel.Workbook
Dim xlsheet As New Excel.Worksheet
Dim xlQuery As New Excel.QueryTable
你能講講是哪些函數和功能不能用嗎?
那要快很多的
lihonggen0(李洪根,用VB,标准答案来了) :
你說的是一種比較理想的狀況.
如果表格裡面每一行的Sql語句都不一樣,或者說必須通過循環來實現的話,你這樣用Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1")好像就部大可能.
不知我的意思表達清楚了沒有.
1.創建Excel對象.
2.頁面設置的一些語句執行.二.如果難以忍受太慢的速度,而打算加ProgressBar的朋友.要注意一點的是:
如果想在ProgressBar走的時候在旁邊加上一個說明性的Label或者Textbox來顯示程序執行到的地方,一定要在Label或者Textbox賦值語句後加上Me.Refresh.否則你Label或者Textbox裡面的內容不會根據程序執行來發生變化.
如果你要顯示的數據必須是通過多個SQL語句來高定的話,就不能像上面的兄弟那麼用了.
如果可以用循環來實現顯示sql查詢數據的話,可以先將查出來的數據放到自己定義的一個數組中,然後用Range.FormulaArray=定義的數組,就可以填充數據,這樣也比較快
:你好!
你在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].但我無論怎麼修改都還是一樣的錯誤.
請你幫忙!如果你能回覆我們將非常感謝!
是否可以? 我的程序就相当于这个功能