VB辅导:VB6中将数据导出到Excel提速之法计算机二级考试

文章作者 100test 发表时间 2009:05:13 18:15:22
来源 100Test.Com百考试题网

　　2009年下半年全国计算机等级考试你准备好了没?考计算机等级考试的朋友,2009年下半年全国计算机等级考试时间是2009年9月19日至23日。更多优质资料尽在百考试题论坛 百考试题在线题库
　　Excel 是一个非常优秀的报表制作软件，用VBA可以控制其生成优秀的报表，本文通过添加查询语句的方法，即用Excel中的获取外部数据的功能将数据很快地从一个查询语句中捕获到EXCEL中，比起往每个CELL里写数据的方法提高许多倍。
　　在程序中引用Microsoft Excel 9.0 Object Library，将下文加入到一个模块中,窗体中调用如下ExporToExcel("0select * 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 下运行通过。

　　特别推荐：

　　2009年9月全国计算机等级考试时间及科目预告

　　2009年上半年全国计算机等级考试参考答案请进入计算机考试论坛

　　2009年全国计算机等级考试报名信息汇总

　　2009年NCRE考试有新变化

　　2009年全国计算机等级考试-大纲

　　2009年上半年全国计算机二级考试试题及答案

　　2009年上半年全国计算机等级考试试题答案汇总