PB数据窗口导出到EXCEL函数
function f_oletoexcel(adw datawindow,title string,as_file string) Oleobject ole_object String s_english="ABCDEFGHIJKLMNOPQRSTUVWXYZ" String ls_obj,ls_objs[],ls_objtag[],ls_width[],ls_value,column_name,ls_coltype,ls_range Integer li_ret,i,li_grouprow,li_newgrouprow,j,row,groupflag,detailflag,sumflag Long ll_row,ll_num,ll_column,ll_groupnum,ll_sumrow Int li_rtn=-9 dec ld_width Pointer oldpointer groupflag=0 detailflag=1 sumflag=1 /*-------打开EXCELL文档-------*/ ole_object = CREATE OLEObject li_ret = ole_object.ConnectToObject("","Excel.Application") IF li_ret <> 0 THEN /*--如果Excel还没有打开则新建--*/ li_ret = ole_object.ConnectToNewObject("Excel.Application") if li_ret <> 0 then MessageBox('OLE错误','OLE无法连接!错误号：' + string(li_ret)) li_rtn = -1 goto totheend end if ole_object.Visible = False //一般自动保存时设为不可视 END IF /*-------打开文档完毕-------*/ oldpointer = SetPointer(HourGlass!) ole_object.Workbooks.Add ll_row = 1 ll_column =long(adw.Object.DataWindow.Column.Count) ll_num = 1 //"#1"可以指向第一列，＃2则指向datawindow的第二列 FOR i = 1 TO ll_column IF adw.Describe("#"+String(i)+".Visible")="1" and adw.Describe("#"+String(i)+".Band")="detail" THEN yield() ls_obj = adw.Describe("#"+String(i)+".name") ls_objs[ll_num] = ls_obj ls_objtag[ll_num]=adw.Describe(ls_obj+"_t.text") //字段名称的显示值 // messagebox(ls_obj,adw.Describe(ls_obj+"_t.text")) ls_width[ll_num]= adw.Describe(ls_obj + '.width') //每列的宽度 ll_num++ END IF NEXT //messagebox("",ll_column) ll_column = upperbound(ls_objs) if ll_column <= 26 then ls_range = Char(64+ll_column) else ls_range = char(64+integer((ll_column - 1)/26))+char(64+integer(mod((ll_column - 1),26)+1)) end if IF trim(title)<>"" THEN ll_row = 2 /*-------生成标题-------*/ ole_object.Cells(1,1).Value =title ole_object.Range('A1').Select ole_object.Selection.Font.Size =24 ole_object.selection.HorizontalAlignment =3 ole_object.Range('A1:'+ls_range+'1').Select ole_object.Range('A1:'+ls_range+'1').Merge END IF /*-------设置标题栏-------*/ for i = 1 to ll_column yield() ls_value = ls_objtag ole_object.cells(ll_row,i).value = ls_value //1 if isnull(ls_width ) then ld_width=12 else ld_width=dec(ls_width )/35 end if ole_object.Columns(i).ColumnWidth=ld_width ole_object.Columns(i).HorizontalAlignment =3 ole_object.Columns(i).Borders.LineStyle= 1 ole_object.Columns(i).Font.Bold =True next IF groupflag = 1 and detailflag = 0 THEN ll_row ++ END IF li_grouprow = 0 ll_groupnum = 0 IF groupflag = 1 THEN FOR i = 1 to adw.rowcount() li_newgrouprow = adw.findgroupchange(i,1) IF li_newgrouprow = i THEN IF li_grouprow > 0 THEN row = i*detailflag + ll_row + ll_groupnum for j = 1 to ll_column yield() column_name = ls_objs[j]+"_c" ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(li_grouprow)+")") ls_coltype=adw.Describe(column_name+'.coltype') IF isnull(ls_value) or ls_value="!" or ls_value = "?" THEN ls_value = "" END IF if pos(upper(ls_coltype),"CHAR")>0 then //对字符型数据处理 ole_object.cells(row,j).NumberFormat ="@" end if ole_object.cells(row,j).Font.Bold =true ole_object.cells(row,j).value = ls_value next ll_groupnum++ li_grouprow = li_newgrouprow ELSE li_grouprow = li_newgrouprow END IF IF detailflag = 1 THEN row = i + ll_row + ll_groupnum for j = 1 to ll_column yield() column_name = ls_objs[j] if adw.Describe(column_name + '.type') = 'column' then ls_value = adw.Describe("Evaluate('LookupDisplay("+column_name+")',"+string(i)+")") end if if adw.Describe(column_name + '.type') = 'compute' then ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(i)+")") end if IF isnull(ls_value) or ls_value="!" or ls_value = "?" THEN ls_value = "" END IF ls_coltype=adw.Describe(column_name+'.coltype') if pos(upper(ls_coltype),"CHAR")>0 then //对字符型数据处理 ole_object.cells(row,j).NumberFormat ="@" end if ole_object.cells(row,j).Font.Bold =false ole_object.cells(row,j).value = ls_value next END IF ELSE IF detailflag = 1 THEN row = i + ll_row + ll_groupnum for j = 1 to ll_column yield() column_name = ls_objs[j] if adw.Describe(column_name + '.type') = 'column' then ls_value = adw.Describe("Evaluate('LookupDisplay("+column_name+")',"+string(i)+")") end if if adw.Describe(column_name + '.type') = 'compute' then ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(i)+")") end if IF isnull(ls_value) or ls_value="!" or ls_value = "?" THEN ls_value = "" END IF ls_coltype=adw.Describe(column_name+'.coltype') if pos(upper(ls_coltype),"CHAR")>0 then //对字符型数据处理 ole_object.cells(row,j).NumberFormat ="@" end if ole_object.cells(row,j).Font.Bold =false ole_object.cells(row,j).value = ls_value next END IF END IF NEXT ll_sumrow = i*detailflag + ll_row + ll_groupnum IF groupflag = 1 THEN row = i*detailflag + ll_row + ll_groupnum ll_sumrow++ for j = 1 to ll_column yield() column_name = ls_objs[j]+"_c" ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(li_grouprow)+")") ls_coltype=adw.Describe(column_name+'.coltype') IF isnull(ls_value) or ls_value="!" or ls_value = "?" THEN ls_value = "" END IF if pos(upper(ls_coltype),"CHAR")>0 then //对字符型数据处理 ole_object.cells(row,j).NumberFormat ="@" end if ole_object.cells(row,j).Font.Bold =true ole_object.cells(row,j).value = ls_value next END IF ELSE FOR i = 1 TO adw.rowcount() for j = 1 to ll_column yield() column_name = ls_objs[j] if adw.Describe(column_name + '.type') = 'column' then ls_value = adw.Describe("Evaluate('LookupDisplay("+column_name+")',"+string(i)+")") //得到所见字段数据 end if if adw.Describe(column_name + '.type') = 'compute' then ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(i)+")")//得到所见计算字段数据 end if IF isnull(ls_value) or ls_value="!" or ls_value = "?" THEN ls_value = "" END IF ls_coltype=adw.Describe(column_name+'.coltype') if pos(upper(ls_coltype),"CHAR")>0 then //对字符型数据处理 ole_object.cells(ll_row+i,j).NumberFormat ="@" end if ole_object.cells(ll_row+i,j).Font.Bold =false ole_object.cells(ll_row+i,j).value = ls_value next NEXT ll_sumrow = ll_row + i END IF debugbreak() IF sumflag = 1 THEN for j = 1 to ll_column yield() column_name = ls_objs[j]+"_sum" if adw.Describe(column_name+".Name") <>"!" then ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(1)+")") ls_coltype=adw.Describe(column_name+'.coltype') IF isnull(ls_value) or ls_value="!" or ls_value = "?" THEN ls_value = "" END IF if pos(upper(ls_coltype),"CHAR")>0 then //对字符型数据处理 ole_object.cells(ll_sumrow,j).NumberFormat ="@" end if ole_object.cells(ll_sumrow,j).Font.Bold =true ole_object.cells(ll_sumrow,j).value = ls_value end if next END IF if FileExists ( as_file ) then if messagebox("Microsoft Excel","在当前位置发现已经存在名为"+as_file+" 的文件。您希望将该文件替换掉吗？", & Question!,YesNoCancel!) = 1 then if not FileDelete ( as_file ) then messagebox("错误","文件"+as_file+"删除失败;~r~n请确定磁盘未满或未被写保护且文件未被使用。!") li_rtn = -1 goto totheend end if else li_rtn = -1 goto totheend end if end if ole_object.ActiveWorkbook.saveas(as_file) ole_object.Displayalerts = FALSE //关闭在退出EXCEL时的保存提示 if IsValid ( w_prompt ) then close(w_prompt); If MessageBox('系统提示','报表已成功导出,是否现在查看导出结果?',Question!,YesNo!)=1 Then ole_object.Visible = True Else ole_object.Quit() //退出EXCEL End If li_rtn = 1 totheend: if IsValid ( w_prompt ) then close(w_prompt); //w_prompt是一个信息显示窗体 SetPointer(oldpointer) If IsValid(ole_object) Then ole_object.disconnectobject() If IsValid(ole_object) Then DESTROY ole_object //of_waitfor('','') return li_rtn
