PB数据窗口导出到EXCEL函数
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
g.csdn.net/lxh84/archive/2007/06/30/1672465.aspx
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
ld_width=12
else
ld_width=dec(ls_width
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
g.csdn.net/lxh84/archive/2007/06/30/1672465.aspx