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[i]
   ole_object.cells(ll_row,i).value = ls_value  //1
   if isnull(ls_width[i]) then
  ld_width=12
 else
  ld_width=dec(ls_width[i])/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