Powerbulider Data window to Microsoft EXECL, Word program source code

word| Program | data | Source code powerbulider Data window to Microsoft EXECL, Word program source code
First, F_cncharnum function f_cncharnum.srf
$PBExportHeader $F_CNCHARNUM.SRF
$PBExportComments $ to get the number of Chinese characters or double bytes in a string
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);
Function Name: F_cncharnum
Purpose: Returns the number of Chinese characters in a string
Input: astring-string, given string
Return value: Li_num-integer, number of characters in a given string
Note: 1. This method is based on the validity of the location code of Chinese character library, which does not conform to this encoding system this function is invalid!
2. If the Chinese character string contains non-Chinese characters, such as graphic symbols or ASCII codes, these characters will remain unchanged.
For example: Li_ret = F_cncharnum ("Ferry Man ferryman") Li_ret = 3

String ls_ch//staging unit
String ls_secondsectable//storage of all GB level two Chinese pronunciation
Integer li_num = 0//return value
Integer I,J

For i = 1 to Len (astring)
Ls_ch = Mid (astring,i,1)
If ASC (ls_ch) >= 128 then//is Chinese character
li_num++
i = i+1
End If
Next

Return Li_num

End Function


Second, Pbtoexcel function 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);
Function Name: f_outputtoexcel_new
Input: Adw-datawindow, specified data window
return value: 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
If Excel is not yet open, create new.
Li_ret = Ole_object. Connecttonewobject ("Excel.Application")
If Li_ret <> 0 Then
MessageBox (' OLE error ', ' OLE cannot connect! Error Number: ' + 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

Gets the number of columns and rows in the Data window data (the number of rows should be data rows + 1)
Ll_colnum = Ll_num
Ll_rownum = Adw.rowcount () + 1

String Ls_colname
Integer i,j,k
For i = 1 to Ll_colnum
Get the name of the title head
Ls_value = Ls_objtag[i]
Ole_object.cells (1,i). Value = Ls_value
Next

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
Next
Next

Setpointer (Oldpointer)

Ole_object.disconnectobject ()
DESTROY Ole_object

Return 1
End Function

Three, Pbtoword function 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);
Function Name: f_outputtoword_new
Input: Adw-datawindow, specified data window
return value: 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
If Word is not yet open, new.
Li_ret = Ole_object. Connecttonewobject ("Word.Application")
If Li_ret <> 0 Then
MessageBox (' OLE error ', ' OLE cannot connect! Error Number: ' + 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

Gets the number of columns and rows in the Data window data (the number of rows should be data rows + 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
Get the name of the title head
Ls_value = Ls_objtag[i]
Ole_object. Selection.TypeText (Ls_value)
For k = 1 to F_cncharnum (Ls_value)
Ole_object. Selection.typebackspace ()
Next
Ole_object. Selection.MoveRight (Wdcell)
Next

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 ()
Next
Next
Next
Adw.setredraw (True)

Constant Long wdformatdocument = 0

Setpointer (Oldpointer)
Save a new document
If MessageBox ("Save", "the document has completed successfully, is it saved?) ", question!,yesno!) = 1 Then
String DocName, named
Integer value

Value = Getfilesavename ("Select File", 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

End If
To disconnect an OLE connection
Ole_object.disconnectobject ()
Destroy Ole_object

Return 1
End Function