PB数据窗口导出到EXCEL函数

向右看齐 2023-10-18 08:11 22阅读 0赞

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  
  
本文来自CSDN博客，转载请标明出处： [http://blo][http_blo]  
  
g.csdn.net/lxh84/archive/2007/06/30/1672465.aspx

[http_blo]: http://blo