| 标题 | 用vba实现将记录集输出到Excel模板 |
| 内容 | 代码如下: '************************************************ '** 函数名称: ExportTempletToExcel '** 函数功能: 将记录集输出到 Excel 模板 '** 参数说明: '** strExcelFile 要保存的 Excel 文件 '** strSQL 查询语句，就是要导出哪些内容 '** strSheetName 工作表名称 '** adoConn 已经打开的数据库连接 '** 函数返回: '** Boolean 类型 '** True 成功导出模板 '** False 失败 '** 参考实例: '** Call ExportTempletToExcel(c:\\text.xls,查询语句,工作表1,adoConn) '************************************************ Private Function ExportTempletToExcel(ByVal strExcelFile As String, _ ByVal strSQL As String, _ ByVal strSheetName As String, _ ByVal adoConn As Object) As Boolean Dim adoRt As Object Dim lngRecordCount As Long ' 记录数 Dim intFieldCount As Integer ' 字段数 Dim strFields As String ' 所有字段名 Dim i As Integer Dim exlApplication As Object ' Excel 实例 Dim exlBook As Object ' Excel 工作区 Dim exlSheet As Object ' Excel 当前要操作的工作表 On Error GoTo LocalErr Me.MousePointer = vbHourglass '// 创建 ADO 记录集对象 Set adoRt = CreateObject(ADODB.Recordset) With adoRt .ActiveConnection = adoConn .CursorLocation = 3 'adUseClient .CursorType = 3 'adOpenStatic .LockType = 1 'adLockReadOnly .Source = strSQL .Open If .EOF And .BOF Then ExportTempletToExcel = False Else '// 取得记录总数，+ 1 是表示还有一行字段名名称信息 lngRecordCount = .RecordCount + 1 intFieldCount = .Fields.Count - 1 For i = 0 To intFieldCount '// 生成字段名信息（vbTab 在 Excel 里表示每个单元格之间的间隔） strFields = strFields & .Fields(i).Name & vbTab Next '// 去掉最后一个 vbTab 制表符 strFields = Left$(strFields, Len(strFields) - Len(vbTab)) '// 创建Excel实例 Set exlApplication = CreateObject(Excel.Application) '// 增加一个工作区 Set exlBook = exlApplication.Workbooks.Add '// 设置当前工作区为第一个工作表（默认会有3个） Set exlSheet = exlBook.Worksheets(1) '// 将第一个工作表改成指定的名称 exlSheet.Name = strSheetName '// 清除“剪切板” Clipboard.Clear '// 将字段名称复制到“剪切板” Clipboard.SetText strFields '// 选中A1单元格 exlSheet.Range(A1).Select '// 粘贴字段名称 exlSheet.Paste '// 从A2开始复制记录集 exlSheet.Range(A2).CopyFromRecordset adoRt '// 增加一个命名范围，作用是在导入时所需的范围 exlApplication.Names.Add strSheetName, = & strSheetName & !$A$1:$ & _ uGetColName(intFieldCount + 1) & $ & lngRecordCount '// 保存 Excel 文件 exlBook.SaveAs strExcelFile '// 退出 Excel 实例 exlApplication.Quit ExportTempletToExcel = True End If 'adStateOpen = 1 If .State = 1 Then .Close End If End With LocalErr: '********************************************* '** 释放所有对象 '********************************************* Set exlSheet = Nothing Set exlBook = Nothing Set exlApplication = Nothing Set adoRt = Nothing '********************************************* If Err.Number <> 0 Then Err.Clear End If Me.MousePointer = vbDefault End Function '// 取得列名 Private Function uGetColName(ByVal intNum As Integer) As String Dim strColNames As String Dim strReturn As String '// 通常字段数不会太多，所以到 26*3 目前已经够了。 strColNames = A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z, & _ AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ, & _ BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ strReturn = Split(strColNames, ,)(intNum - 1) uGetColName = strReturn End Function |
| 随便看 |
|
在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。