网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的范文：

　

标题 asp操作excel的方法
范文
    代码如下:
    <%
    '*******************************************************************
    '使用说明
    'dim a
    'set a=new createexcel
    'a.savepath=x '保存路径
    'a.sheetname=工作簿名称 '多个工作表 a.sheetname=array(工作簿名称一,工作簿名称二)
    'a.sheettitle=表名称 '可以为空 多个工作表 a.sheetname=array(表名称一,表名称二)
    'a.data =d '二维数组 '多个工作表 array(b,c) b与c为二维数组
    'dim rs
    'set rs=server.createobject(adodb.recordset)
    'rs.open select id, classid, classname from [class] ,conn, 1, 1
    'a.adddbdata rs, 字段名一，字段名二, 工作簿名称, 表名称, true 'true自动获取表字段名
    'a.adddata c, true , 工作簿名称, 表名称 'c二维数组 true 第一行是否为标题行
    'a.addtdata e, sheet1 '按模板生成 c=array(array(aa1, 内容), array(aa2, 内容2))
    'a.create()
    'a.usedtime 生成时间，毫秒数
    'a.savepath 保存路径
    'set a=nothing
    '设置com组件的操作权限。在命令行键入“dcomcnfg”，则进入com组件配置界面，选择microsoftexcel后点击属性按钮，将三个单选项一律选择自定义，编辑中将everyone加入所有权限
    '*******************************************************************
    class createexcel
    private createtype_
    private savepath_
    private readpath_
    private authorstr rem 设置作者
    private versionstr rem 设置版本
    private systemstr rem 设置系统名称
    private sheetname_ rem 设置表名
    private sheettitle_ rem 设置标题
    private exceldata rem 设置表数据
    private excelapp rem excel.application
    private excelbook
    private excelsheets
    private usedtime_ rem 使用的时间
    public titlefirstline rem 首行是否标题
    private sub class_initialize()
    server.scripttimeout = 99999
    usedtime_ = timer
    systemstr = lc00_createexcelserver
    authorstr = surnfu 31333716
    versionstr = 1.0
    if not isobjinstalled(excel.application) then
    inerr(服务器未安装excel.application控件)
    end if
    set excelapp = createobject(excel.application)
    excelapp.displayalerts = false
    excelapp.application.visible = false
    createtype_ = 1
    readpath_ = null
    end sub
    private sub class_terminate()
    excelapp.quit
    if isobject(excelsheets) then set excelsheets = nothing
    if isobject(excelbook) then set excelbook = nothing
    if isobject(excelapp) then set excelapp = nothing
    end sub
    public property let readpath(byval val)
    if instr(val, :)<>0 then
    readpath_ = trim(val)
    else
    readpath_=server.mappath(trim(val))
    end if
    end property
    public property let savepath(byval val)
    if instr(val, :)<>0 then
    savepath_ = trim(val)
    else
    savepath_=server.mappath(trim(val))
    end if
    end property
    public property let createtype(byval val)
    if val <> 1 and val <> 2 then
    createtype_ = 1
    else
    createtype_ = val
    end if
    end property
    public property let data(byval val)
    if not isarray(val) then
    inerr(表数据设置有误)
    end if
    exceldata = val
    end property
    public property get savepath()
    savepath = savepath_
    end property
    public property get usedtime()
    usedtime = usedtime_
    end property
    public property let sheetname(byval val)
    if not isarray(val) then
    if val = then
    inerr(表名设置有误)
    end if
    titlefirstline = true
    else
    redim titlefirstline(ubound(val))
    dim ik_
    for ik_ = 0 to ubound(val)
    titlefirstline(ik_) = true
    next
    end if
    sheetname_ = val
    end property
    public property let sheettitle(byval val)
    if not isarray(val) then
    if val = then
    inerr(表标题设置有误)
    end if
    end if
    sheettitle_ = val
    end property
    rem 检查数据
    private sub checkdata()
    if savepath_ = then inerr(保存路径不能为空)
    if not isarray(sheetname_) then
    if sheetname_ = then inerr(表名不能为空)
    end if
    if createtype_ = 2 then
    if not isarray(exceldata) then
    inerr(数据载入错误，或者未载入)
    end if
    exit sub
    end if
    if isarray(sheetname_) then
    if not isarray(sheettitle_) then
    if sheettitle_ <> then inerr(表标题设置有误，与表名不对应)
    end if
    end if
    if not isarray(exceldata) then
    inerr(表数据载入有误)
    end if
    if isarray(sheetname_) then
    if getarraydim(exceldata) <> 1 then inerr(表数据载入有误，数据格式错误，维度应该为一)
    else
    if getarraydim(exceldata) <> 2 then inerr(表数据载入有误，数据格式错误，维度应该为二)
    end if
    end sub
    rem 生成excel
    public function create()
    call checkdata()
    if not isnull(readpath_) then
    excelapp.workbooks.open(readpath_)
    else
    excelapp.workbooks.add
    end if
    set excelbook = excelapp.activeworkbook
    set excelsheets = excelbook.worksheets
    if createtype_ = 2 then
    dim ih_
    for ih_ = 0 to ubound(exceldata)
    call setsheets(exceldata(ih_), ih_)
    next
    excelbook.saveas savepath_
    usedtime_ = formatnumber((timer - usedtime_)*1000, 3)
    exit function
    end if
    if isarray(sheetname_) then
    dim ik_
    for ik_ = 0 to ubound(exceldata)
    call createsheets(exceldata(ik_), ik_)
    next
    else
    call createsheets(exceldata, -1)
    end if
    excelbook.saveas savepath_
    usedtime_ = formatnumber((timer - usedtime_)*1000, 3)
    end function
    private sub createsheets(byval data_, dataid_)
    dim spreadsheet
    dim tempsheettitle
    dim temptitlefirstline
    if dataid_<>-1 then
    if dataid_ > excelsheets.count - 1 then
    excelsheets.add()
    set spreadsheet = excelbook.sheets(1)
    else
    set spreadsheet = excelbook.sheets(dataid_ + 1)
    end if
    if isarray(sheettitle_) then
    tempsheettitle = sheettitle_(dataid_)
    else
    tempsheettitle =
    end if
    temptitlefirstline = titlefirstline(dataid_)
    spreadsheet.name = sheetname_(dataid_)
    else
    set spreadsheet = excelbook.sheets(1)
    spreadsheet.name = sheetname_
    tempsheettitle = sheettitle_
    temptitlefirstline = titlefirstline
    end if
    dim line_ : line_ = 1
    dim rownum_ : rownum_ = ubound(data_, 1) + 1
    dim lastcols_
    if tempsheettitle <> then
    'spreadsheet.columns(1).shrinktofit=true '设定是否自动适应表格单元大小(单元格宽不变）
    lastcols_ = getcolname(ubound(data_, 2) + 1)
    with spreadsheet.cells(1, 1)
    .value = tempsheettitle
    '设置excel表里的字体
    .font.bold = true '单元格字体加粗
    .font.italic = false '单元格字体倾斜
    .font.size = 20 '设置单元格字号
    .font.name=宋体 '设置单元格字体
    '.font.colorindex=2 '设置单元格文字的颜色，颜色可以查询，2为白色
    end with
    with spreadsheet.range(a1:& lastcols_ &1)
    .merge '合并单元格(单元区域)
    '.interior.colorindex = 1 '设计单元络背景色
    .horizontalalignment = 3 '居中
    end with
    line_ = 2
    rownum_ = rownum_ + 1
    end if
    dim irow_, icol_
    dim drow_, dcol_
    dim templastrange : templastrange = getcolname(ubound(data_, 2)+1) & (rownum_)
    dim beginrow : beginrow = 1
    if tempsheettitle <> then beginrow = beginrow + 1
    if temptitlefirstline = true then beginrow = beginrow + 1
    if beginrow=1 then
    with spreadsheet.range(a1:& templastrange)
    .borders.linestyle = 1
    .borderaround -4119, -4138 '设置外框
    .numberformatlocal = @ '文本格式
    .font.bold = false
    .font.italic = false
    .font.size = 10
    .shrinktofit=true
    end with
    else
    with spreadsheet.range(a1:& templastrange)
    .borders.linestyle = 1
    .borderaround -4119, -4138
    .shrinktofit=true
    end with
    with spreadsheet.range(a& beginrow &:& templastrange)
    .numberformatlocal = @
    .font.bold = false
    .font.italic = false
    .font.size = 10
    end with
    end if
    if temptitlefirstline = true then
    beginrow = 1
    if tempsheettitle <> then beginrow = beginrow + 1
    with spreadsheet.range(a& beginrow &:& getcolname(ubound(data_, 2)+1) & (beginrow))
    .numberformatlocal = @
    .font.bold = true
    .font.italic = false
    .font.size = 12
    .interior.colorindex = 37
    .horizontalalignment = 3 '居中
    .font.colorindex=2
    end with
    end if
    for irow_ = line_ to rownum_
    for icol_ = 1 to (ubound(data_, 2) + 1)
    dcol_ = icol_ - 1
    if tempsheettitle <> then drow_ = irow_ - 2 else drow_ = irow_ - 1
    if not isnull(data_(drow_, dcol_)) then
    with spreadsheet.cells(irow_, icol_)
    .value = data_(drow_, dcol_)
    end with
    end if
    next
    next
    set spreadsheet = nothing
    end sub
    rem 测试组件是否已经安装
    private function isobjinstalled(strclassstring)
    on error resume next
    isobjinstalled = false
    err = 0
    dim xtestobj
    set xtestobj = server.createobject(strclassstring)
    if 0 = err then isobjinstalled = true
    set xtestobj = nothing
    err = 0
    end function
    rem 取得数组维数
    private function getarraydim(byval arr)
    getarraydim = null
    dim i_, temp
    if isarray(arr) then
    for i_ = 1 to 60
    on error resume next
    temp = ubound(arr, i_)
    if err.number <> 0 then
    getarraydim = i_ - 1
    err.clear
    exit function
    end if
    next
    getarraydim = i_
    end if
    end function
    private function getnumformatlocal(datatype)
    select case datatype
    case currency:
    getnumformatlocal = ￥#,##0.00_);(￥#,##0.00)
    case time:
    getnumformatlocal = [$-f800]dddd, mmmm dd, yyyy
    case char:
    getnumformatlocal = @
    case common:
    getnumformatlocal = g/通用格式
    case number:
    getnumformatlocal = #,##0.00_
    case else :
    getnumformatlocal = @
    end select
    end function
    public sub adddbdata(byval rsflied, byval fliedtitle, byval tempsheetname_, byval tempsheettitle_, dbtitle)
    if rsflied.eof then exit sub
    dim colnum_ : colnum_ = rsflied.fields.count
    dim rownum_ : rownum_ = rsflied.recordcount
    dim arrfliedtitle
    if dbtitle = true then
    fliedtitle =
    dim ig_
    for ig_=0 to colnum_ - 1
    fliedtitle = fliedtitle & rsflied.fields.item(ig_).name
    if ig_ <> colnum_ - 1 then fliedtitle = fliedtitle &,
    next
    end if
    if fliedtitle<> then
    rownum_ = rownum_ + 1
    arrfliedtitle = split(fliedtitle, ,)
    if ubound(arrfliedtitle) <> colnum_ - 1 then
    inerr(获取数据库表有误，列数不符)
    end if
    end if
    dim tempdata : redim tempdata(rownum_ - 1, colnum_ - 1)
    dim ix_, iy_
    dim iz
    if fliedtitle<> then iz = rownum_ - 2 else iz = rownum_ - 1
    for ix_ = 0 to iz
    for iy_ = 0 to colnum_ - 1
    if fliedtitle<> then
    if ix_=0 then
    tempdata(ix_, iy_) = arrfliedtitle(iy_)
    tempdata(ix_ + 1, iy_) = rsflied(iy_)
    else
    tempdata(ix_ + 1, iy_) = rsflied(iy_)
    end if
    else
    tempdata(ix_, iy_) = rsflied(iy_)
    end if
    next
    rsflied.movenext
    next
    dim tempfirstline
    if fliedtitle<> then tempfirstline = true else tempfirstline = false
    call adddata(tempdata, tempfirstline, tempsheetname_, tempsheettitle_)
    end sub
    public sub adddata(byval tempdate_, byval tempfirstline_, byval tempsheetname_, byval tempsheettitle_)
    if not isarray(exceldata) then
    exceldata = tempdate_
    titlefirstline = tempfirstline_
    sheetname_ = tempsheetname_
    sheettitle_ = tempsheettitle_
    else
    if getarraydim(exceldata) = 1 then
    dim temparrlen : temparrlen = ubound(exceldata)+1
    redim preserve exceldata(temparrlen)
    exceldata(temparrlen) = tempdate_
    redim preserve titlefirstline(temparrlen)
    titlefirstline(temparrlen) = tempfirstline_
    redim preserve sheetname_(temparrlen)
    sheetname_(temparrlen) = tempsheetname_
    redim preserve sheettitle_(temparrlen)
    sheettitle_(temparrlen) = tempsheettitle_
    else
    dim tempolddata : tempolddata = exceldata
    exceldata = array(tempolddata, tempdate_)
    titlefirstline = array(titlefirstline, tempfirstline_)
    sheetname_ = array(sheetname_, tempsheetname_)
    sheettitle_ = array(sheettitle_, tempsheettitle_)
    end if
    end if
    end sub
    rem 模板增加数据方法
    public sub addtdata(byval tempdate_, byval tempsheetname_)
    createtype_ = 2
    if not isarray(exceldata) then
    exceldata = array(tempdate_)
    sheetname_ = array(tempsheetname_)
    else
    dim temparrlen : temparrlen = ubound(exceldata)+1
    redim preserve exceldata(temparrlen)
    exceldata(temparrlen) = tempdate_
    redim preserve sheetname_(temparrlen)
    sheetname_(temparrlen) = tempsheetname_
    end if
    end sub
    private sub setsheets(byval data_, dataid_)
    dim spreadsheet
    set spreadsheet = excelbook.sheets(sheetname_(dataid_))
    spreadsheet.activate
    dim ix_
    for ix_ =0 to ubound(data_)
    if not isarray(data_(ix_)) then inerr(表数据载入有误，数据格式错误)
    if ubound(data_(ix_)) <> 1 then inerr(表数据载入有误，数据格式错误)
    spreadsheet.range(data_(ix_)(0)).value = data_(ix_)(1)
    next
    set spreadsheet = nothing
    end sub
    public function gettime(msec_)
    dim retime_ : retime_=
    if msec_ < 1000 then
    retime_ = msec_ &ms
    else
    dim second_
    second_ = (msec_ 1000)
    if (msec_ mod 1000)<>0 then
    msec_ = (msec_ mod 1000) &毫秒
    else
    msec_ =
    end if
    dim n_, arytime(2), arytimeunit(2)
    arytimeunit(0) = 秒
    arytimeunit(1) = 分
    arytimeunit(2) = 小时
    n_ = 0
    dim tempsecond_ : tempsecond_ = second_
    while(tempsecond_ / 60 >= 1)
    tempsecond_ = fix(tempsecond_ / 60 * 100) / 100
    n_ = n_ + 1
    wend
    dim m_
    for m_ = n_ to 0 step -1
    arytime(m_) = second_ (60 ^ m_)
    second_ = second_ mod (60 ^ m_)
    retime_ = retime_ & arytime(m_) & arytimeunit(m_)
    next
    if msec_<> then retime_ = retime_ & msec_
    end if
    gettime = retime_
    end function
    rem 取得列名
    private function getcolname(byval colnum)
    dim arrlitter : arrlitter=split(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, )
    dim revalue_
    if colnum <= ubound(arrlitter) + 1 then
    revalue_ = arrlitter(colnum - 1)
    else
    revalue_ = arrlitter(((colnum-1) 26)) & arrlitter(((colnum-1) mod 26))
    end if
    getcolname = revalue_
    end function
    rem 设置错误
    private sub inerr(errinfo)
    err.raise vbobjecterror + 1, systemstr &(version & versionstr &), errinfo
    end sub
    end class
    dim b(4,6)
    dim c(50,20)
    dim i, j
    for i=0 to 4
    for j=0 to 6
    b(i,j) =i&-&j
    next
    next
    for i=0 to 50
    for j=0 to 20
    c(i,j) = i&-&j &我的
    next
    next
    dim e(20)
    for i=0 to 20
    e(i)= array(a&(i+1), i+1)
    next
    '使用示例 需要xx.xls模板支持
    'set a=new createexcel
    'a.readpath = xx.xls
    'a.savepath=xx-1.xls
    'a.addtdata e, sheet1
    'a.create()
    'response.write(生成& a.savepath &　使用了 & a.gettime(a.usedtime) &<br>)
    'set a=nothing
    '使用示例一
    set a=new createexcel
    a.savepath=x.xls
    a.adddata b, true , 测试c, 测试c
    a.titlefirstline = false '首行是否为标题行
    a.create()
    response.write(生成& a.savepath &　使用了 & a.gettime(a.usedtime) &<br>)
    set a=nothing
    '使用示例二
    set a=new createexcel
    a.savepath=y.xls
    a.sheetname=工作簿名称 '多个工作表 a.sheetname=array(工作簿名称一,工作簿名称二)
    a.sheettitle=表名称 '可以为空 多个工作表 a.sheetname=array(表名称一,表名称二)
    a.data =b '二维数组 '多个工作表 array(b,c) b与c为二维数组
    a.create()
    response.write(生成& a.savepath &　使用了 & a.gettime(a.usedtime) &<br>)
    set a=nothing
    '使用示例三 生成两个表
    set a=new createexcel
    a.savepath=z.xls
    a.sheetname=array(工作簿名称一,工作簿名称二)
    a.sheettitle=array(表名称一,表名称二)
    a.data =array(b, c) 'b与c为二维数组
    a.titlefirstline = array(false, true) '首行是否为标题行
    a.create()
    response.write(生成& a.savepath &　使用了 & a.gettime(a.usedtime) &<br>)
    set a=nothing
    '使用示例四 需要数据库支持
    'dim rs
    'set rs=server.createobject(adodb.recordset)
    'rs.open select id, classid, classname from [class] ,conn, 1, 1
    'set a=new createexcel
    'a.savepath=a
    'a.adddbdata rs, 序号,类别序号,类别名称, 工作簿名称, 类别表, false
    'a.create()
    'response.write(生成& a.savepath &　使用了 & a.gettime(a.usedtime) &<br>)
    'set a=nothing
    'rs.close
    'set rs=nothing
    %>
随便看

　

在线学习网范文大全提供好词好句、学习总结、工作总结、演讲稿等写作素材及范文模板，是学习及工作的有利工具。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/21 18:23:46