| 标题 | 用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 |
| 随便看 |
|
在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。