PowerBulider数据窗口转MicroSoft Execl、Word程序源代码

PowerBulider数据窗口转MicroSoft Execl、Word程序源代码 PowerBulider数据窗口转MicroSoft Execl、Word程序源代码一、f_cncharnum函数 f_cncharnum.srf

$PBExportHeader$f_cncharnum.srf

$PBExportComments$得到字符串中汉字或者双字节的个数

global type f_cncharnum from function_object

end type

forward prototypes

global function integer f_cncharnum (string aString)

end prototypes

global function integer f_cncharnum (string aString);

//函数名: f_cncharnum

//用途: 返回一个字符串中汉字的个数

//输入: aString - string, 给定的字符串

//返回值: li_num - Integer, 给定的字符串中汉字的个数

//注意: 1. 此方法基于汉字的国标汉字库区位编码的有效性，不符合此编码的系统此函数无效！

// 2. 若汉字串含有非汉字字符,如图形符号或ASCII码,则这些非汉字字符将保持不变.

//例如: li_ret = f_cncharnum("摆渡人ferryman") li_ret = 3

string ls_ch //临时单元

string ls_SecondSecTable //存放所有国标二级汉字读音

integer li_num = 0 //返回值

integer i,j

For i = 1 to Len(aString)

ls_ch = Mid(aString,i,1)

If Asc(ls_ch) >= 128 then //是汉字

li_num++

i = i+1

End if

Return li_num

end function

二、PBToExcel函数f_outputtoexcel_new.srf

$PBExportHeader$f_outputtoexcel_new.srf

global type f_outputtoexcel_new from function_object

end type

forward prototypes

global function integer f_outputtoexcel_new (datawindow adw)

end prototypes

global function integer f_outputtoexcel_new (datawindow adw);

//函数名:f_outputtoexcel_new

//输入: adw - datawindow,指定的数据窗口

//返回值: Integer

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

//如果Excel还没有打开，则新建。

li_ret = ole_object.ConnectToNewObject("Excel.Application")

if li_ret <> 0 then

MessageBox('OLE错误','OLE无法连接!错误号：' + string(li_ret))

return 0

end if

ole_object.Visible = True

END IF

pointer oldpointer

oldpointer = SetPointer(HourGlass!)

ole_object.Workbooks.Add

long ll_colnum,ll_rownum

string ls_value

string ls_objects,ls_obj,ls_objs[],ls_objtag[]

long ll_pos,ll_len,ll_num = 0

ls_objects = trim(adw.Describe('datawindow.Objects'))

do while (pos(ls_objects,"~t") > 0)

ll_pos = pos(ls_objects,"~t")

ll_len = ll_pos - 1

ls_obj = left(ls_objects,ll_len)

if (adw.Describe(ls_obj + '.type') = 'column' or &

adw.Describe(ls_obj + '.type') = 'compute') and &

(adw.Describe(ls_obj + '.band') = 'detail') and (ls_obj <> "asd") then

ll_num += 1

ls_objs[ll_num] = ls_obj

ls_objtag[ll_num] = adw.Describe(ls_obj + '.tag')

end if

ls_objects = right(ls_objects,len(ls_objects) - ll_pos)

loop

//得到数据窗口数据的列数与行数（行数应该是数据行数 + 1）

ll_colnum = ll_num

ll_rownum = adw.rowcount() + 1

string ls_colname

integer i,j,k

for i = 1 to ll_colnum

//得到标题头的名字

ls_value = ls_objtag[i]

ole_object.cells(1,i).value = ls_value

string column_name

for i = 2 to ll_rownum

for j = 1 to ll_colnum

column_name = ls_objs[j]

if adw.Describe(column_name + '.type') = 'column' then

ls_value = adw.Describe("Evaluate('LookupDisplay("+column_name+")',"+string(i - 1)+")")

end if

if adw.Describe(column_name + '.type') = 'compute' then

ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(i - 1)+")")

end if

ole_object.cells(i,j).value = ls_value

SetPointer(oldpointer)

ole_object.disconnectobject()

DESTROY ole_object

return 1

end function

三、PBToWord函数f_outputtoword_new.srf

$PBExportHeader$f_outputtoword_new.srf

global type f_outputtoword_new from function_object

end type

forward prototypes

global function integer f_outputtoword_new (datawindow adw)

end prototypes

global function integer f_outputtoword_new (datawindow adw);

//函数名:f_outputtoword_new

//输入: adw - datawindow,指定的数据窗口

//返回值: Integer

constant integer ppLayoutBlank = 12

OLEObject ole_object

ole_object = CREATE OLEObject

integer li_ret

li_ret = ole_object.ConnectToObject("","word.application")

IF li_ret <> 0 THEN

//如果Word还没有打开，则新建。

li_ret = ole_object.ConnectToNewObject("word.application")

if li_ret <> 0 then

MessageBox('OLE错误','OLE无法连接!错误号：' + string(li_ret))

return 0

end if

ole_object.Visible = True

END IF

long ll_colnum,ll_rownum

constant long wdWord9TableBehavior = 1

constant long wdAutoFitFixed = 0

constant long wdCell = 12

string ls_value

pointer oldpointer

oldpointer = SetPointer(HourGlass!)

string ls_objects,ls_obj,ls_objs[],ls_objtag[]

long ll_pos,ll_len,ll_num = 0

ls_objects = trim(adw.Describe('datawindow.Objects'))

do while (pos(ls_objects,"~t") > 0)

ll_pos = pos(ls_objects,"~t")

ll_len = ll_pos - 1

ls_obj = left(ls_objects,ll_len)

if (adw.Describe(ls_obj + '.type') = 'column' or &

adw.Describe(ls_obj + '.type') = 'compute') and &

(adw.Describe(ls_obj + '.band') = 'detail') and (ls_obj <> "asd") then

ll_num += 1

ls_objs[ll_num] = ls_obj

ls_objtag[ll_num] = adw.Describe(ls_obj + '.tag')

end if

ls_objects = right(ls_objects,len(ls_objects) - ll_pos)

loop

//得到数据窗口数据的列数与行数（行数应该是数据行数 + 1）

ll_colnum = ll_num

ll_rownum = adw.rowcount() + 1

ole_object.Documents.Add()

ole_object.ActiveDocument.Tables.Add(ole_object.Selection.Range, ll_rownum, ll_colnum)

string ls_colname

integer i,j,k

for i = 1 to ll_colnum

//得到标题头的名字

ls_value = ls_objtag[i]

ole_object.Selection.TypeText(ls_value)

for k = 1 to f_cncharnum(ls_value)

ole_object.Selection.TypeBackspace()

ole_object.Selection.MoveRight(wdCell)

adw.setredraw(false)

ole_object.Selection.MoveLeft(wdCell)

string column_name

for i = 2 to ll_rownum

for j = 1 to ll_colnum

column_name = ls_objs[j]

if adw.Describe(column_name + '.type') = 'column' then

ls_value = adw.Describe("Evaluate('LookupDisplay("+column_name+")',"+string(i - 1)+")")

end if

if adw.Describe(column_name + '.type') = 'compute' then

ls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(i - 1)+")")

end if

ole_object.Selection.MoveRight(wdCell)

ole_object.Selection.TypeText(ls_value)

for k = 1 to f_cncharnum(ls_value)

ole_object.Selection.TypeBackspace()

adw.setredraw(true)

constant long wdFormatDocument = 0

SetPointer(oldpointer)

//保存新建的文档

if messagebox("保存","文档已经成功完成，是否保存？",Question!,YesNo!) = 1 then

string docname, named

integer value

value = GetFileSaveName("选择文件",docname, named, "DOC","Doc Files (*.DOC), *.DOC")

IF value = 1 THEN

ole_object.ActiveDocument.SaveAs(docname, 0,False,"",True,"",False,False,False, False,False)

end if

//断开OLE连接

Ole_Object.DisConnectObject()

Destroy Ole_Object

return 1

end function