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
' Rs_Data.Open strOpen, Cn, adOpenStatic, adLockReadOnly
With Rs_Data
' .MoveFirst
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
浅谈Excel 的VB编程
---- Excel是一个优秀的电子表格软件，如果你编的程序需要以报表的形式显示最终结果，它会是个不错的选择。你可以通过VB控制Excel显示数据表格。如果你不愿意深入了解Excel这些琐碎的细节，也不是没有权宜之计：你可以打开Excel中的工具→宏→录制新宏，然后进行手工操作，结束后把所录的宏代码贴进你的VB程序就行。这样得到的程序一般都能正常运行，但其中的宏代码往往不够简洁，效率和可读性都不高。
---- Excel编程碰到的第一个问题是表头。有时表头的形式比较复杂，需要横向或纵向合并单元格。请放心，只要没有斜杠，Excel都能应付得了。
---- 例如合并A2~A5这4个单元格，你录制的宏代码会是这样：
Range("A2:A5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
---- 而自己编程只要一句 Range.(“A2:A5”).mergecells=True 就可以解决问题。
---- 表头形式定了，再就是表头的内容。如果单元格中的文本长度超过了列宽，往往只能显示部分内容，行尾那一格的内容则会“越境”进入右边那个空白单元格，很不美观。这个问题可以通过在程序中设置列宽加以解决。
---- Columns(14).columnwidth=12 ‘设置第14列列宽为12（缺省列宽为8.38）
---- 如果你不愿意劳神去逐列估计实际所需的列宽，干脆来一行
---- Columns(“a:i”).autofit ‘a到i列自动调整列宽
---- 让Excel随机应变吧。
---- 但也许你不喜欢这种方法，认为表头撑大了列宽，弄得浏览一张小表格还得向右滚动，太不方便了。要是能保持默认列宽，让文本自动换行就好了。没问题，Excel包你满意。
---- Rows(3).WrapText=True ‘让第三行各单元格中的文本自动换行
---- 不过你最好再加一句 Rows(3) .VerticalAlignment = xlTop 让表头自动向上对齐，这样比较符合习惯。
---- 你还可以给表头打上底色，让你的读者不至于看了打哈欠。
---- Rows(2). Interior .ColorIndex = 5 '设置第2行底色为蓝色
---- 再给表格的标题上色，这样更醒目一点。
---- Rows(1).Font.ColorIndex=4
---- 表头完成后该填数据了，一个一个地填实在是太慢了，如果你的数据是存放在一个二维数组中，那问题就简单多了。
Dim Data(3,4)
………… ‘数据处理
Range(“a2:d4”).Value=Data
---- 这样可以一次填入一个表的所有数据，够快了吧！不过提醒一句，Range对象大小最好与数组匹配，小了无法显示所有数据，大了则会在空白单元格只填入“N/A”表示没有取得数据。
---- 如果需要在结果中显示多个同样规格的数据表，想在Range对象中加入循环变量，这也好办。
Dim cell11,cell2
Dim Data(3,4)
…………
For I =1 to 40
………… ‘数据处理
Set cell1=Worksheets("Sheet1").Cells(5*I-4,1)
Set cell2=Worksheets("Sheet1").Cells(5*I-2,4)
Worksheets("Sheet1").Range(cell1,cell2).value=Data
Next I
---- 表格填完了，现在该打表格线了，以下几条语句可以满足你的要求：
With Worksheets("Sheet1").Range(cell1,cell2).borders
.LineStyle=xlContinuous
.weight=xlThin
End With
---- 好了，关于Excel的VB编程今天就讲到这儿吧。
用VB创建复杂表格
---- 数据库管理系统的开发人员经常感叹的一个问题就是：我们中国人的报表太复杂了！无规则、嵌套、斜线、交叉线等历来都是困挠开发人员的最大问题。设计一个数据库固然有一定的技巧，设计数据操作也固然需要一定的逻辑分析能力，但这些问题对一般的开发人员来说应该是不成为问题的。用户可是不管你采用了多么灵活的算法多么方便的操作，他们最感兴趣的是最后他们出来的报表如何漂亮，出报表的操作如何简单（最好是一个按钮解决所有的问题）。笔者在开发数据库管理系统方面也稍有些经验，从FoxPro、Delphi、PowerBuilder一直到现在用的VB，都遇到过设计打印报表的问题，这些软件在设计报表的过程中可谓各有千秋，我这里不一一细说。我在这里只向大家介绍一种我迄今为止最为满意的一种设计打印报表的方法：利用VB操作EXCEL来生成复杂的报表。
---- 一. 用VB创建外部EXCEL对象
---- 大多数大型 ActiveX-enabled 应用程序和其它 ActiveX 部件，在它们的对象层次中都提供了一个顶层外部可创建对象。该对象提供了对该层次中其它对象的访问，并且还提供对整个应用程序起作用的方法和属性。
---- 例如，每个 Microsoft Office 应用程序提供一个顶层 Application 对象。下面语句显示了对Microsoft Excel的 Application 对象的引用：
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
---- 然后，可以用这些变量来访问在EXCEL应用程序中的从属对象、以及这些对象的属性和方法。例如：
Set xlApp = CreateObject("Excel.Application")
‘激活EXCEL应用程序
xlApp.Visible = False ‘隐藏EXCEL应用程序窗口
Set xlBook = xlApp.Workbooks.Open(strDestination)
‘打开工作簿，strDestination为一个EXCEL报表文件
Set xlSheet = xlBook.Worksheets(1)
‘设定工作表
---- 二. 用EXCEL 97设计报表的模版文件
---- EXCEL 97是一个非常优秀的创建报表的工具。它提供的单元格任意合并、拆分和绘图功能基本上能够满足设计所有复杂报表的需求。它对任意一个单元格的格式随意控制，更为随心所欲地设计报表提供了强大的支持。
---- 根据用户提供的报表，我们可以很快在EXCEL里生成模版文件。所谓生成模版文件只是为了满足用户多方面的需求而设计的。也是为了适合报表以后的更改而做的一点预备工作。例如用户需要打印几百张职工履历表，但其格式都是一致的，并且随着时间和实际情况的变化，表格格式有可能需要改变，我们设计一个模版文件显然可以“以不变应万变”了。
---- 生成工作表时我们应当记录下要填充内容的单元格编号和该单元格内要填充的数据字段。这样形成一个表格，在写程序时一目了然。如：
Cell(4,2) 职工姓名 Cell(6,6) 毕业学校
Cell(4,4) 职工性别 Cell(6,7) 所学专业
Cell(4,6) 职工民族 Cell(6,9) 工作时间
（表一）
---- 在程序里我们当然不要对模版文件进行操作了，我们只需要对模版文件的一个拷贝进行操作就行（这也是我们设计模版文件的一个目的和好处）。如下面的例子：
Dim strSource, strDestination As String
strSource = App.Path & "\Excels\RegisterFee.xls"
‘RegisterFee.xls就是一个模版文件
strDestination = App.Path & "\Excels\Temp.xls"
FileCopy strSource, strDestination
‘将模版文件拷贝到一个临时文件
---- 三. 生成工作表内容
---- 有了上述两步工作的铺垫，我们下面接着就只要根据（表一）的格式给各单元格赋值了。如：
datPrimaryRS.Recordset.MoveFirst
‘datPrimaryRS为Data控件
If IsNull(datPrimaryRS.Recordset!姓名) = False Then
xlSheet.Cells(4, 2) = datPrimaryRS.Recordset!姓名
End If
If IsNull(datPrimaryRS.Recordset!性别) = False Then
xlSheet.Cells(4, 4) = datPrimaryRS.Recordset!性别
End If
If IsNull(datPrimaryRS.Recordset!民族) = False Then
xlSheet.Cells(4, 6) = datPrimaryRS.Recordset!民族
End If
………………
---- 四. 打印报表
---- 生成了工作表后，就可以对EXCEL发出打印指令了。
---- 注意在执行打印操作之前应该对EXCEL临时文件执行一次保存操作，以免在退出应用程序后EXCEL还提示用户是否保存已修改的文件，让用户觉得莫名其妙。如下语句：
xlBook.Save ‘保存文件
xlSheet.PrintOut ‘执行打印
xlApp.Quit ‘退出EXCEL
