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