http://www.softexam.cn/eschool/details.asp?id=11604&page=2
收藏的一个导出为 excel 的例子
(支持导出分组带、合计带,并且支持多层嵌套报表导出,基本是所见及所得)
///
//
// Parameters : ad_dw : datawindow
// as_file : file name
// Returns : true/false : boolean
// Description : Save the datawindow as a excel file.
//
///
// author : purplekite
// date : 2003-01-23
///
SetPointer(HourGlass!)
//declare the local variables
long i, j, li_pos
string ls_objects, ls_obj, ls_text, ls_err, ls_sql
datastore lds_saveas //导出数据窗
datastore lds_sort //获得根据 object.x 排序的 (band = detail and visible = 1) 的 column/compute
boolean lb_return //返回值
string ls_pbver //pb 版本信息
environment env //环境变量
getenvironment(env)
ls_pbver = string(env.pbmajorrevision)
//创建排序列 datastore
lds_sort = create datastore
ls_sql = 'column=(type=char(1) name = ztext dbname="ztext" )' + '~r~n' + &
'column=(type=char(1) name = zcol dbname="zcol" )' + '~r~n' + &
'column=(type=long name = zx dbname="zx" )' + '~r~n'
ls_sql = 'release ' + ls_pbver + ';~r~ntable(' + ls_sql + ')'
lds_sort.create(ls_sql, ls_err)
if len(ls_err) > 0 then
lb_return = false
goto lab1
end if
//准备数据====================================================
//all controls
ls_objects = ad_dw.Describe("datawindow.objects")
//按~t位置作判断开始循环
do while (pos(ls_objects,"~t") > 0)
li_pos = pos(ls_objects,"~t")
ls_obj = left(ls_objects,li_pos - 1)
ls_objects = right(ls_objects,len(ls_objects) - li_pos)
//(column or compute ) at detail and visible
IF (ad_dw.Describe(ls_obj+".type") = "column" or &
ad_dw.Describe(ls_obj+".type") = "compute" ) AND &
(ad_dw.Describe(ls_obj+".band") = "detail" ) AND &
(ad_dw.Describe(ls_obj+".visible") = "1" ) THEN
ls_text = ad_dw.describe(ls_obj + '_t.text')
if ls_text <> '!' and ls_text <> '?' then
lds_sort.insertrow(0)
lds_sort.setitem(lds_sort.rowcount(), 'ztext', ls_text)
lds_sort.setitem(lds_sort.rowcount(), 'zcol', ls_obj)
lds_sort.setitem(lds_sort.rowcount(), 'zx', long(ad_dw.describe(ls_obj + '.x')))
end if
END IF
loop
//the last control
ls_obj = ls_objects
IF (ad_dw.Describe(ls_obj+".type") = "column" or &
ad_dw.Describe(ls_obj+".type") = "compute" ) AND &
(ad_dw.Describe(ls_obj+".band") = "detail" ) AND &
(ad_dw.Describe(ls_obj+".visible") = "1" ) THEN
ls_text = ad_dw.describe(ls_obj + '_t.text')
if ls_text <> '!' and ls_text <> '?' then
lds_sort.insertrow(0)
lds_sort.setitem(lds_sort.rowcount(), 'ztext', ls_text)
lds_sort.setitem(lds_sort.rowcount(), 'zcol', ls_obj)
lds_sort.setitem(lds_sort.rowcount(), 'zx', long(ad_dw.describe(ls_obj + '.x')))
end if
END IF
//如果没有列则跳出
if lds_sort.rowcount() < 1 then goto lab1
//根据 object.x 排序
lds_sort.setsort('zx A')
lds_sort.sort()
//创建导出 datastore
lds_saveas = create datastore
ls_sql = ''
for i = 1 to lds_sort.rowcount()
ls_obj = lds_sort.getitemstring(i, 'zcol')
ls_sql += 'column=(type=char(1) dbname="' + ls_obj + '" )' + '~r~n'
next
ls_sql = 'release ' + ls_pbver + ';~r~ntable(' + ls_sql + ')'
lds_saveas.create(ls_sql, ls_err)
if len(ls_err) > 0 then
lb_return = false
goto lab1
end if
//向 lds_saveas 中写数据
for i = 1 to ad_dw.rowcount()
yield()//释放消息队列, 如果数据量较大, 可以使用这个函数
lds_saveas.insertrow(0)
for j = 1 to lds_sort.rowcount()
ls_obj = lds_sort.getitemstring(j, 'zcol')
if ad_dw.describe(ls_obj + '.type') = 'column' then
ls_text = ad_dw.describe('evaluate(~'LookUpDisplay(' + ls_obj + ')~', ' + string(i) + ')')
else
ls_text = ad_dw.describe('evaluate(~'' + ls_obj + '~',' + string(i) + ')')
end if
lds_saveas.setitem(i, j, ls_text)
next
next
lds_saveas.insertrow(1)
for i = 1 to lds_sort.rowcount()
lds_saveas.setitem(1, i, lds_sort.getitemstring(i, 'ztext'))
next
//准备数据完毕====================================================
//saveas datawindow
lb_return = (lds_saveas.saveas(as_file, excel!, false) = 1)
lab1:
destroy lds_sort
destroy lds_saveas
SetPointer(Arrow!)
return lb_return
另一个,思路是先SaveAsascii(),再格式化为XLS
http://www.hur.cn/bbs/html/board85/topic57572.html
- 最近查了几个解决这个问题,但总是不理想,DW2XL这个不会用,下载了一个PBL,加载后调用函数,在导出时报错,OLD简单些,但还有些不如人意,大家谁有好的解决方案,请指导一下,
作者:jackyeagle 时间:2007-3-21 16:48:00第 7 楼
-
//函数说明:
//用于报表导出功能,主要实现DATAWINDOW导出到EXCLE中,原DATAWINDOW表头的处理问题
//几个问题:表头太复杂,导出后与下面的数据不对应!int li_value
string ls_path,ls_fname
li_value = GetFilesaveName("请选择导出文件", &
+ ls_path, ls_fname, "XLS", &
+ "Excel文件 (*.xls), *.xls," &
+ "Word 文件 (*.doc), *.doc,"&
+ "文本 文件 (*.txt), *.txt,")
IF li_value <> 1 THEN return 0
setpointer(hourglass!)
// 删除原文件
if fileexists(ls_path) then
if messagebox('提示信息', '原文件已经存在, 是否覆盖 ?', Question!, YesNo!) = 2 then return 0
if not filedelete(ls_path) then
messagebox('提示信息', '删除原文件失败, 该文件可能正在被使用 !')
return 0
end if
end if
if dw_1.SaveAsascii(ls_path) = -1 then
MessageBox("提示信息", "导出数据出错. 不能写入文件 !", Exclamation!)
return 0
else
messagebox('提示信息','数据导出成功 !', Exclamation!)
return 1
end if/**********以下程序将导出的EXCEL英文标题替换为汉字*********/
long numcols,numrows,c,r
OLEObject xlapp,xlsub
int ret
numcols=long(dw_1.Object.DataWindow.Column.Count)
numrows=dw_1.RowCount()
//产生oleobject的实例
xlApp=Create OLEObject
//连接ole对象
ret=xlApp.ConnectToNewObject("Excel.Sheet")
if ret<0 then
MessageBox("连接失败!","连接到EXCEL失败,请确认您的系统是否已经安装EXCEL!~r~n"&
+"错误代码:"+string(ret))
return -1
end if
//打开EXCEL文件
xlApp.Application.Workbooks.Open(ls_path)
使文件可见
//xlApp.Application.Visible=true
//得到活动工作表的引用,改善程序性能
xlsub=xlapp.Application.ActiveWorkbook.Worksheets[1]
string ls_colname,ls_text,ls_modistr,ls_col
//取字段名更改为对应的文本text值
FOR c=1 to numcols
ls_col="#"+string(c)+".name"
ls_colname=dw_1.describe(ls_col)
ls_modistr=ls_colname+"_t.text"
ls_text=dw_1.describe(ls_modistr)
xlsub.cells[1,c]=ls_text
NEXTxlApp.DisConnectObject()
Destroy xlapp
MessageBox("提示信息","导出数据成功!")
return 1//success这个函数基本还可以,请大家帮忙看下,优化一下,一个主要问题是导出来如果是字符型的,但到EXCEL里自动转为数值型,大家帮忙看看,还有就是表格复杂时,效果不好,看能不能再优化一下,在此谢过!!