Visual Basic 導出到 Excel 提速之法
2024-07-21 02:21:03
供稿：網友
excel 是一個非常優秀的報表制作軟件，用vba可以控制其生成優秀的報表，本文通過添加查詢語句的方法，即用excel中的獲取外部數據的功能將數據很快地從一個查詢語句中捕獲到excel中,比起往每個cell里寫數據的方法提高許多倍。
將下文加入到一個模塊中,屏幕中調用如下exportoexcel("select * from table")則實現將其導出到excel中
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
with rs_data
if .state = adstateopen then
.close
end if
.activeconnection = cn
.cursorlocation = aduseclient
.cursortype = adopenstatic
.locktype = adlockreadonly
.source = stropen
.open
end with
with rs_data
if .recordcount < 1 then
msgbox ("沒有記錄!")
exit function
end if
'記錄總數
irowcount = .recordcount
'字段總數
icolcount = .fields.count
end with
set xlapp = createobject("excel.application")
set xlbook = nothing
set xlsheet = nothing
set xlbook = xlapp.workbooks().add
set xlsheet = xlbook.worksheets("sheet1")
xlapp.visible = true
'添加查詢語句，導入excel數據
set xlquery = xlsheet.querytables.add(rs_data, xlsheet.range("a1"))
with xlquery
.fieldnames = true
.rownumbers = false
.filladjacentformulas = false
.preserveformatting = true
.refreshonfileopen = false
.backgroundquery = true
.refreshstyle = xlinsertdeletecells
.savepassword = true
.savedata = true
.adjustcolumnwidth = true
.refreshperiod = 0
.preservecolumninfo = true
end with
xlquery.fieldnames = true '顯示字段名
xlquery.refresh
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
with xlsheet.pagesetup
.leftheader = "" & chr(10) & "&""楷體_gb2312,常規""&10公司名稱：" ' & gsmc
.centerheader = "&""楷體_gb2312,常規""公司人員情況表&""宋體,常規""" & chr(10) & "&""楷體_gb2312,常規""&10日 期："
.rightheader = "" & chr(10) & "&""楷體_gb2312,常規""&10單位："
.leftfooter = "&""楷體_gb2312,常規""&10制表人："
.centerfooter = "&""楷體_gb2312,常規""&10制表日期："
.rightfooter = "&""楷體_gb2312,常規""&10第&p頁 共&n頁"
end with
xlapp.application.visible = true
set xlapp = nothing '"交還控制給excel
set xlbook = nothing
set xlsheet = nothing
end function
注:須在程序中引用'microsoft excel 9.0 object library'和ado對象,機器必裝excel 2000
本程序在windows 98/2000,vb 6 下運行通過。
