用这个
global type f_pbtoexcel from function_object
end type
forward prototypes
global function integer f_pbtoexcel (datawindow adw)
end prototypes
global function integer f_pbtoexcel (datawindow adw);integer li_rtn,ii,li_asc
string ls_name,ls_pathname
boolean lb_exist
if adw.RowCount()<1 then
MessageBox('提示信息','请先检索数据再导出至Excel!')
return -1 //error
end if
li_rtn=GetFileSaveName('保存文件',ls_pathname,ls_name,'xls','Excel文件(*.xls),*.xls')
if li_rtn=1 then
lb_exist = FileExists(ls_pathname)
IF lb_exist THEN
li_rtn = MessageBox('保存', ls_pathname+'已经存在,是否覆盖?',Exclamation!, YesNo!)
end if
if li_rtn=1 then
//当文件存在用户选择覆盖，或是文件本就不存在时。注意变量li_rtn
li_rtn=adw.SaveAsAscii(ls_pathname)
if li_rtn=1 then
// MessageBox(＇提示信息＇,＇导出数据成功!＇)
else
MessageBox('错误信息','导出数据失败!')
return -1 //error
end if
else
return -1 //error
end if
else
return -1
end if
/**********以下程序将导出的EXCEL英文标题替换为汉字*********/
long numcols , numrows , c, r
OLEObject xlapp , xlsub
int ret
numcols = long(adw.Object.DataWindow.Column.Count)
numrows = adw.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_pathname)
////使文件可见
//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=adw.describe(ls_col)
ls_modistr=ls_colname+'_t.text'
ls_text=adw.describe(ls_modistr)
xlsub.cells[1,c]=ls_text
NEXT
xlapp.Application.DisplayAlerts = False
xlApp.Application.Quit()
xlApp.DisConnectObject()
Destroy xlapp
MessageBox('提示信息','导出数据成功!')
return 1 //success
end function
