PB数据窗口数据导出到word,excel,dw2word,dw2xls

PB数据窗口数据导出到word,excel,dw2word,dw2xls
2008-10-10 12:29
PB 数据窗口数据导出到word,excel, dw2word,dw2xls dw2word,dw2xls
PB 数据窗口数据导出到word,excel, excel 可以自定义修改excel文档的列宽对齐方式,字体样式等
// dwsave2word 调用ole
global type gf_exportdata2word from function_object
end type
forward prototypes
global subroutine gf_exportdata2word (datawindow ad_datawindow)
end prototypes
global subroutine gf_exportdata2word (datawindow ad_datawindow);string ls_filepath
ls_filepath=gf_getfilesavename()
OleObject OleObjectWord
OleObjectWord=Create OleObject
// 连接word
if OleObjectWord.ConnectT oNewObject("Word.application") <> 0 then
Messagebox("提示","ole连接错误！")
return
end if
OleObjectWord.visible=false //word文档在操作数据过程中是否可见
Long col_colnum,col_rownum
Constant Long wdTableBehavior=1
Constant Long wdAutoFitFixed=0
Constant Long wdCell=12
String str_value
// 得到数据窗口数据的列数和行数（行数应该是数据行数＋1）col_colnum=Long(ad_datawindow.object.datawindow.colu mn.count)
col_rownum=ad_datawindow.rowcount() + 1
// 先在word文档中画好表格
SetPointer(HourGlass!)
OleObjectWord.Documents.Add
OleObjectWord.ActiveDocument.Tables.Add(OleObjectWor d.Selection.Range,&
+col_rownum,col_colnum,wdTableBehavior,wdAutoFitFixed) string ls_colname
integer i,j,k,l
for i=1 to col_colnum
//得到标题头的名称
ls_colname=ad_datawindow.Describe('#'+string(i)+".name") + "_t"
str_value=ad_datawindow.DEscribe(ls_colname+".text")
OleObjectWord.Selection.TypeText(str_value)
OleObjectWord.Selection.MoveRight(wdCell)
Next
ad_datawindow.setRedraw(false)
OleObjectWord.Selection.MoveLeft(wdCell)
SetPointer(HourGlass!)
for i=2 to col_rownum
for j=1 to col_colnum
ad_datawindow.Scrolltorow(i - 1)
ad_datawindow.SetColumn(j)
str_value=ad_datawindow.GetItemstring(i - 1,j)
if isnull(str_value) then
str_value=''
end if
OleObjectWord.Selection.MoveRight(wdCell)
OleObjectWord.Selection.TypeText(str_value)
next
next
ad_datawindow.setredraw(true)
Constant long wdFormatDocument=0
// 保存新建的文档
OleObjectWord.ActiveDocument.SaveAs(ls_filepath,0,false,"" ,true,"",false,false,false,false,false)
boolean lb_exist
lb_exist = FileExists(ls_filepath)
if lb_exist then
messagebox("提示","数据已经保存到"+ls_filepath)
end if
//断开ole连接
OleObjectWord.DisconnectObject()
destroy OleObjectWord
end subroutine
// dwsave2xls 调用ole
global type gf_dwsavetoexcel from function_object
end type
forward prototypes
global function integer gf_dwsavetoexcel (datawindow adw) end prototypes
global function integer gf_dwsavetoexcel (datawindow adw); string xlsname, named
integer value
string col_del,first_del
value = GetFileSaveName("另存为", xlsname,named,"XLS","Xls Files (*.XLS), *.XLS") if value = 1 then
adw.saveas(xlsname,Excel!,TRUE)
else
return 2
end if
constant integer ppLayoutBlank = 12
OLEObject ole_object
ole_object = CREATE OLEObject
integer li_ret
li_ret = ole_object.ConnectToObject("","Excel.Application" )
IF li_ret <> 0 THEN
li_ret = ole_object.ConnectToNewObject("Excel.Applicatio n")
IF li_ret <> 0 THEN
messagebox("OLE错误","OLE无法连接!~r~n错误号:" + string(li_ret))
Return 0
END IF
ole_object.visible = False
END IF
pointer oldpointer
oldpointer = SetPointer(HourGlass!)
ole_object.Workbooks.open(xlsname)
ole_object.WorkSheets[1].Activate
long columncount, rowscount
columncount = long(adw.object.datawindow.column.cou nt)
rowscount = adw.rowcount() + 1
string ls_colname[],ls_value
integer i,j
long handle
handle = OpenChannel("Excel", xlsname)
// 将列名转化为中文名称，即标题头名称
for j = 1 to columncount
ls_colname[j] = adw.describe("#"+string(j)+".name")
ls_value = adw.describe(ls_colname[j]+"_t"+".text")
// ole_object.activesheet.cells[1,j].value = ls_value 开始的方法
SetRemote("R1C"+STRING(J), ls_value, handle)
next
datawindowchild ldw_child
long ll_found
For j = 1 To columncount
//col_del标识将要删除不可见的列
if adw.Describe("#" + String(j) + ".visible") ="0" the n
IF integer(j)<27 then
//当列小于26时，excel中用A-Z表示列号
first_del = char(integer(J)+64)
else
//大于26,小于等于52列时,AA-AZ,大于52列时可能性不大未做考虑
first_del= "A"+char(integer(J)+38)
end if
col_del=col_del + first_del +":"+ first_del+", "
continue
end if
//当列可见且为下拉数据窗口时，数据值转化为显示值
If adw.Describe("#" + String(j) + ".edit.style") = 'dd dw' Then
adw.GetChild( ls_colname[j], ldw_child )
for i=1 to rowscount - 1
//"dm","dmyy"是我通常用下拉数据子窗口的值以及显示值
//更通用的方法是用DDDW.DataColumn，DDDW.DisplayColumn得到
ll_found = ldw_child.Find("dm" +"= '"+adw.getitemstri ng(i,j)+"'", 1, ldw_child.RowCount())
if ll_found>0 then
SetRemote("R"+STRING(i+1)+"C"+STRING(J),ldw_child.getit emstring(ll_found,"dmyy"), handle)
end if
//另外一种方法，数据量大时比现用方法速度慢
//SetRemote("R"+STRING(i+1)+"C"+STRING(J),adw.Describ e("Evaluate('LookUpDisplay(#"+string(j)+")',"+string(i)+")"), ha ndle)
next
end if
next
CloseChannel(handle)
if col_del<>'' then
COL_DEL=LEFT(COL_DEL,LEN(COL_DEL) - 2)
//删除不可见列
ole_object.activesheet.range(col_del).Delete
end if
SetPointer(oldpointer)
ole_object.ActiveWorkBook.Save()
ole_object.application.quit()
ole_object.Disconnectobject()
Destroy ole_object
Return 1
end function
string ls_assize,named
int li_value,li_rt,li_rc,li_rt1
//li_value=gf_dwsavetoexcel(dw_detail)
//if dw_detail.rowcount() < 1 then return
SetPointer(HourGlass!)
li_value=getfilesavename("Save
File",ls_assize,named,"excel","excel files(*.xls),*.xls,"+& "All files (*.*),*.*")
IF li_value<> 1 then return
li_rt = dw_detail.saveas(ls_assize,excel!,false)
SetPointer(Arrow!)
SetPointer(HourGlass!)
OLEObject Ole_1
Ole_1 = Create OLEObject
li_rc = Ole_1.ConnectToObject(ls_assize)
if li_rc <> 0 then
destroy ole_1
return
end if
Ole_1.Application.Windows(named).Visible=True
Ole_1.Application.DisplayAlerts=False
if li_rt = 1 then
//aOle.Application.Workbooks[1].worksheets[1].columns(7).I nsert
SetPointer(HourGlass!)
Ole_1.Application.Workbooks[1].worksheets[1].Rows(1).Inse rt
// 如何设置导出列的宽度,让列之间有一定的空间?
Ole_1.Sheets(1).Columns("A:Z").ColumnWidth = 22.00 // 设置某个区间的列宽
Ole_1.Sheets(1).Columns[1].ColumnWidth = 13.00 // 设置某一列的列宽
//aOle.Sheets(1).Columns("AG:AI").ColumnWidth = 13.00 //设置对齐方式
// aOle.Sheets(1).Columns(1).Select //sheet1 的第一列的对齐方式
//aOle.Selection.HorizontalAlignment = -4131 //居左
// aOle.Sheets(1).Columns("A:Z").HorizontalAlignment = -4152 //居右
// aOle.Sheets(1).Selection.HorizontalAlignment = -4152 //居右
//aOle.Selection.HorizontalAlignment = -4108 //居中
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,1].val ue = "ICAJCD"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,1].Fo nt.FontStyle = "bold"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,2].val ue = "ICVICH"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,2].Fo nt.FontStyle = "bold"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,3].val ue = "ICVJCH"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,3].Fo nt.FontStyle = "bold"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,4].val ue = "ICVKCH"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,4].Fo nt.FontStyle = "bold"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,5].val ue = "ICVHCH"
Ole_1.Application.Workbooks[1].worksheets[1].Cells[1,5].Fo nt.FontStyle = "bold"
Ole_1.Sheets(1).Columns("A:Z").HorizontalAlignment = -4108 //居中
Ole_1.Application.Save
SetPointer(Arrow!)
Ole_1.Application.Quit
If Ole_1.DisconnectObject() < 0 then
Messagebox(" 岿粇 "," 娩钡岿 ")
else
li_rt1=1
End if
else
messagebox("Note","Export EXCEL Unsuccessful!")
return
end if
if li_rt1 = 1 then
messagebox("Note","Export EXCEL Successful!")
end if
if IsValid(Ole_1) then
Destroy Ole_1
end if
SetPointer(Arrow!)。