Form S_204FA: ActiveX Interface to Excel
* ===================================================================
*
* Component : S_204FA
* Type : Active-X Excel integration
* Ancestor : PRIM_FORM
*
* Description : Active-X Interface to Excel
*
* This example can use a spreadsheet with a maximum of 26 columns (A to Z) and 99 rows.
* To use more columns, increase the size of W_ALF and initialize it with the extra values
* To use more rows, increase the size of XLCOL and XLCOLN and change the SUBSTRING
* code to reflect the new length
*
* Disclaimer : The following material is supplied as sample material
* only. No warranty concerning this material or its use
* in any way whatsoever is expressed or implied.
*
* ===================================================================
FUNCTION OPTIONS(*DIRECT)
BEGIN_COM FORMPOSITION(ScreenCenter) HEIGHT(516) LEFT(308) TOP(122) WIDTH(635)
* Define Screen objects
DEFINE_COM CLASS(#PRIM_TRVW) NAME(#TREEVIEW) DISPLAYPOSITION(1) HEIGHT(441) LEFT(8) PARENT(#DEPTBOX) TABPOSITION(1) TOP(16) WIDTH(225)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_1) KEYPOSITION(1) LEVEL(1) PARENT(#TREEVIEW) SOURCE(#DEPTMENT) VISIBLE(False)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_2) DISPLAYPOSITION(1) LEVEL(1) PARENT(#TREEVIEW) SOURCE(#DEPTDESC)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_3) KEYPOSITION(1) LEVEL(2) PARENT(#TREEVIEW) SOURCE(#SECTION) VISIBLE(False)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_4) DISPLAYPOSITION(1) LEVEL(2) PARENT(#TREEVIEW) SOURCE(#SECDESC)
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#LISTVIEW) DISPLAYPOSITION(1) HEIGHT(281) LEFT(6) PARENT(#GROUPBOX) TABPOSITION(1) TOP(72) WIDTH(377)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) CAPTION('Number ') CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#LISTVIEW) SOURCE(#EMPNO) WIDTH(20)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_2) CAPTION('First Name') CAPTIONTYPE(Caption) DISPLAYPOSITION(2) PARENT(#LISTVIEW) SOURCE(#GIVENAME) WIDTH(25)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_3) CAPTION('Last Name ') CAPTIONTYPE(Caption) DISPLAYPOSITION(3) PARENT(#LISTVIEW) SOURCE(#SURNAME) WIDTH(30)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_4) CAPTION('Salary') CAPTIONTYPE(Caption) DISPLAYPOSITION(4) PARENT(#LISTVIEW) SOURCE(#SALARY) WIDTH(20) WIDTHTYPE(Remainder)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GROUPBOX) CAPTION('Employees') DISPLAYPOSITION(1) HEIGHT(361) LEFT(240) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(104) VISIBLE(False) WIDTH(389)
DEFINE_COM CLASS(#DEPTDESC.Visual) NAME(#DEPTDESC) CAPTION('In Department') DISPLAYPOSITION(2) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(70) PARENT(#GROUPBOX) READONLY(True) TABPOSITION(2) TABSTOP(False) TOP(24) WIDTH(209)
DEFINE_COM CLASS(#SECDESC.Visual) NAME(#SECDESC) CAPTION('In Section ') DISPLAYPOSITION(3) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(70) PARENT(#GROUPBOX) READONLY(True) TABPOSITION(3) TABSTOP(False) TOP(48) WIDTH(209)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_VEMP) CAPTION('View Section Salary Details') DISPLAYPOSITION(3) ENABLED(False) LEFT(248) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(8) WIDTH(175)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_VDEP) CAPTION('View Department Salary Summary') DISPLAYPOSITION(5) ENABLED(False) LEFT(248) PARENT(#COM_OWNER) TABPOSITION(5) TABSTOP(False) TOP(40) WIDTH(175)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_VALL) CAPTION('View All Departments Salary Summary') DISPLAYPOSITION(4) LEFT(248) PARENT(#COM_OWNER) TABPOSITION(4) TOP(72) WIDTH(175)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_PEMP) CAPTION('Print Section salary Details') DISPLAYPOSITION(7) LEFT(432) PARENT(#COM_OWNER) TABPOSITION(7) TOP(8) WIDTH(185)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_PDEP) CAPTION('Print Department Salary Summary') DISPLAYPOSITION(8) HEIGHT(33) LEFT(437) PARENT(#COM_OWNER) TABPOSITION(8) TOP(40) WIDTH(180)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_PALL) CAPTION('Print All Departments Salary Summary') DISPLAYPOSITION(9) HEIGHT(18) LEFT(432) PARENT(#COM_OWNER) TABPOSITION(9) TOP(79) WIDTH(193)
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(2) HEIGHT(25) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(2) TOP(464) WIDTH(627)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#DEPTBOX) CAPTION('Departments and Sections ') DISPLAYPOSITION(6) HEIGHT(465) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(6) TOP(0) WIDTH(241)
* Active_X component details
DEFINE_COM CLASS(#va_excel) NAME(#S_EXCEL) REFERENCE(*DYNAMIC)
Define_Com Class(#va_excel.Worksheet) Name(#WorkSheet) Reference(*Dynamic)
* Work fields
DEFINE FIELD(#FNAME) TYPE(*CHAR) LENGTH(255)
DEFINE FIELD(#EMPLOYEES) REFFLD(#STD_NUM)
DEFINE FIELD(#SALARYTOT) LENGTH(*REFFLD *PLUS 2) REFFLD(#SALARY)
DEFINE FIELD(#SALARYAVE) REFFLD(#SALARY)
* Work fields to fill Excel spreadsheet
DEFINE FIELD(#W_TXT) TYPE(*CHAR) LENGTH(50)
DEFINE FIELD(#XLCOL) TYPE(*CHAR) LENGTH(2)
DEFINE FIELD(#XLCOLN) REFFLD(#DAY) DEFAULT(0)
DEFINE FIELD(#XLCELL) TYPE(*CHAR) LENGTH(4)
DEFINE FIELD(#W_ALF) TYPE(*CHAR) LENGTH(26)
DEFINE FIELD(#I1) REFFLD(#PRIFILRRN)
DEF_ARRAY NAME(#KOL) INDEXES(#I1) OVERLAYING(#W_ALF) TYPE(*CHAR) TOT_ENTRY(26) ENTRY_LEN(1)
*
********************************************************************************************************************
*
* Events
*
* Start of processing
EVTROUTINE handling(#com_owner.Initialize)
SET #com_owner caption(*component_desc)
* Fill array with all the letters of the alphabet
CHANGE FIELD(#W_ALF) TO(ABCDEFGHIJKLMNOPQRSTUVWXYZ)
* Fill tree view with department and section details
Select (#Deptment #DeptDesc) From_File(DepTab)
Select (#Section #SecDesc) From_File(SecTab) With_Key(#Deptment)
Add_Entry #TreeView
EndSelect
EndSelect
ENDROUTINE
* Handle an entry in the tree view getting focus by making the employee details appear on the right (level 2)
* or by making them disappear and by disabling some options
EVTROUTINE HANDLING(#TREEVIEW.ItemGotFocus) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS)
If '#Treeview.CurrentItem.Level = 2'
Set #BTN_VDEP Enabled(False)
Set #BTN_VEMP Enabled(True)
Clr_List #ListView
Select (#empno #SurName #GiveName #salary) From_File(PslMst1) with_key(#Deptment #Section)
Add_Entry #ListView
EndSelect
Set #GroupBox Visible(True)
Else
Set #BTN_VDEP Enabled(True)
Set #BTN_VEMP Enabled(False)
Set #GroupBox Visible(False)
EndIf
ENDROUTINE
*
* Handle request to send contents of employee list view to XL
* and view spreadsheet
*
EVTROUTINE HANDLING(#BTN_VEMP.Click)
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo1.xls')
CHANGE FIELD(#STD_FLAG) TO(V)
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(E)
ENDROUTINE
*
* Handle request to send contents of employee list view to XL
* and print spreadsheet
*
EVTROUTINE HANDLING(#BTN_PEMP.Click)
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo1.xls')
CHANGE FIELD(#STD_FLAG) TO(P)
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(E)
ENDROUTINE
*
* Handle request to send summary of all sections in current department to XL
* and view spreadsheet
*
EVTROUTINE HANDLING(#BTN_VDEP.Click)
CHANGE FIELD(#STD_FLAG) TO(V)
EXECUTE SUBROUTINE(AA_WRK_DEP)
ENDROUTINE
*
* Handle request to send summary of all sections in current department to XL
* and print spreadsheet
*
EVTROUTINE HANDLING(#BTN_PDEP.Click)
CHANGE FIELD(#STD_FLAG) TO(P)
EXECUTE SUBROUTINE(AA_WRK_DEP)
ENDROUTINE
*
* Handle request to send summary of all departments to XL
* and view spreadsheet
*
EVTROUTINE HANDLING(#BTN_VALL.Click)
CHANGE FIELD(#STD_FLAG) TO(V)
EXECUTE SUBROUTINE(AA_WRK_ALL)
ENDROUTINE
*
* Handle request to send summary of all departments to XL
* and print spreadsheet
*
EVTROUTINE HANDLING(#BTN_PALL.Click)
CHANGE FIELD(#STD_FLAG) TO(P)
EXECUTE SUBROUTINE(AA_WRK_ALL)
ENDROUTINE
*
********************************************************************************************************************
*
* Subroutines
*
* Accumulate salary details for selected depatment
*
SUBROUTINE NAME(AA_WRK_DEP)
Def_List #DeptSum (#DeptDesc #secdesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
Select fields(#Section #SecDesc) from_file(Sectab) with_key(#deptment)
Change (#Employees #SalaryTot #SalaryAve) 0
Select Fields(#Salary) From_File(PslMst1) With_Key(#Deptment #Section)
Change #SalaryTot '#SalaryTot + #Salary'
Change #Employees '#Employees + 1'
EndSelect
if '#Employees > 0'
Change #SalaryAve '#SalaryTot / #Employees'
Endif
Add_Entry #DeptSum
Endselect
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo2.xls')
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(D)
Clr_List #DeptSum
ENDROUTINE
*
* Accumulate salary details for all depatments
*
SUBROUTINE NAME(AA_WRK_ALL)
Def_List #AllSum (#DeptDesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
Select fields(#Deptment #DeptDesc) from_file(DepTab)
Change (#Employees #SalaryTot #SalaryAve) 0
Select Fields(#Salary) From_File(PslMst1) With_Key(#Deptment)
Change #SalaryTot '#SalaryTot + #Salary'
Change #Employees '#Employees + 1'
EndSelect
if '#Employees > 0'
Change #SalaryAve '#SalaryTot / #Employees'
Endif
Add_Entry #AllSum
Endselect
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo3.xls')
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(A)
Clr_List #AllSum
ENDROUTINE
SUBROUTINE NAME(BA_EXCEL) PARMS(#LTYP)
DEFINE FIELD(#LTYP) TYPE(*CHAR) LENGTH(1) DESC('List type')
Set_Ref Com(#S_Excel) To(*Create_As #va_excel)
* Open the workbooks
Invoke Method(#s_Excel.Workbooks.Open) Filename(#Fname)
* Activate the spreadsheet (in this example it is called Sheet1)
Set_Ref Com(#Worksheet) To(*Dynamic #S_Excel.Worksheets.Item<'Sheet1'>)
Invoke Method(#Worksheet.Activate)
* Clear out the previous data
Invoke Method(#Worksheet.Cells.ClearContents)
* Initialise column number field of cell
change field(#XLCOLN #XLCOL) TO(*NULL)
* Process appropriate list containing the detail
CASE OF_FIELD(#LTYP)
WHEN VALUE_IS('= A')
EXECUTE SUBROUTINE(CA_ALL_LST)
WHEN VALUE_IS('= D')
EXECUTE SUBROUTINE(CA_DEP_LST)
WHEN VALUE_IS('= E')
EXECUTE SUBROUTINE(CA_EMP_LST)
ENDCASE
* Save spreadsheet without messages
Set #S_EXCEL DisplayAlerts(False)
invoke method(#S_EXCEL.Save)
Set #S_EXCEL DisplayAlerts(True)
* Display spreadsheet if View was selected
CASE OF_FIELD(#STD_FLAG)
WHEN VALUE_IS('= V')
Set #S_EXCEL Visible(True)
WHEN VALUE_IS('= P')
Invoke Method(#Worksheet.Printout)
ENDCASE
ENDROUTINE
* Process the browselist of all departments
SUBROUTINE NAME(CA_ALL_LST)
* Process the list containing data
SELECTLIST NAMED(#AllSum)
EXECUTE SUBROUTINE(CA_FIL_SHT) WITH_PARMS(A)
ENDSELECT
ENDROUTINE
SUBROUTINE NAME(CA_DEP_LST)
* Process the list containing department data
SELECTLIST NAMED(#DeptSum)
EXECUTE SUBROUTINE(CA_FIL_SHT) WITH_PARMS(D)
ENDSELECT
ENDROUTINE
* Process the browselist of employees
SUBROUTINE NAME(CA_EMP_LST)
* Process the list containing data
SELECTLIST NAMED(#ListView)
EXECUTE SUBROUTINE(CA_FIL_SHT) WITH_PARMS(E)
ENDSELECT
ENDROUTINE
* Fill the spreadsheet
SUBROUTINE NAME(CA_FIL_SHT) PARMS(#LTYP)
* Initialise array index for column letter of cell
Change field(#I1) to(*null)
* Increase column number field of cell and make it alpha for TCONCAT
change field(#XLCOLN) TO('#XLCOLN + 1')
IF ('#XLCOLN < 10')
SUBSTRING FIELD(#XLCOLN 2 1) INTO_FIELD(#XLCOL 1 1)
ELSE
IF ('#XLCOLN < 100')
SUBSTRING FIELD(#XLCOLN) INTO_FIELD(#XLCOL)
ENDIF
ENDIF
* Move all fields to spreadsheet
CASE OF_FIELD(#LTYP)
WHEN VALUE_IS('= A')
* Def_List #AllSum (#DeptDesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#DEPTDESC)
SUBSTRING FIELD(#Employees) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salarytot) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salaryave) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
WHEN VALUE_IS('= D')
* Def_List #DeptSum (#DeptDesc #secdesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Deptdesc)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Secdesc)
SUBSTRING FIELD(#Employees) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salarytot) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salaryave) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
WHEN VALUE_IS('= E')
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Empno)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Surname)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Givename)
SUBSTRING FIELD(#Salary) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
ENDCASE
ENDROUTINE
* Fill the individual cells
SUBROUTINE NAME(CA_FIL_CEL) PARMS((#W_TXT *RECEIVED))
* Parameter received is text for the cell
* Increase array index for column letter of cell
change field(#I1) TO('#I1 + 1')
* Determine cell identication (e.g. A1, X6 etc.)
USE BUILTIN(TCONCAT) WITH_ARGS(#KOL#I1 #XLCOL) TO_GET(#XLCELL)
* Move text field value to appropriate cell
Set #S_EXCEL.Range<#XLCELL> Value(#W_TXT)
ENDROUTINE
END_COM
* ===================================================================
*
* Component : S_204FA
* Type : Active-X Excel integration
* Ancestor : PRIM_FORM
*
* Description : Active-X Interface to Excel
*
* This example can use a spreadsheet with a maximum of 26 columns (A to Z) and 99 rows.
* To use more columns, increase the size of W_ALF and initialize it with the extra values
* To use more rows, increase the size of XLCOL and XLCOLN and change the SUBSTRING
* code to reflect the new length
*
* Disclaimer : The following material is supplied as sample material
* only. No warranty concerning this material or its use
* in any way whatsoever is expressed or implied.
*
* ===================================================================
FUNCTION OPTIONS(*DIRECT)
BEGIN_COM FORMPOSITION(ScreenCenter) HEIGHT(516) LEFT(308) TOP(122) WIDTH(635)
* Define Screen objects
DEFINE_COM CLASS(#PRIM_TRVW) NAME(#TREEVIEW) DISPLAYPOSITION(1) HEIGHT(441) LEFT(8) PARENT(#DEPTBOX) TABPOSITION(1) TOP(16) WIDTH(225)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_1) KEYPOSITION(1) LEVEL(1) PARENT(#TREEVIEW) SOURCE(#DEPTMENT) VISIBLE(False)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_2) DISPLAYPOSITION(1) LEVEL(1) PARENT(#TREEVIEW) SOURCE(#DEPTDESC)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_3) KEYPOSITION(1) LEVEL(2) PARENT(#TREEVIEW) SOURCE(#SECTION) VISIBLE(False)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_4) DISPLAYPOSITION(1) LEVEL(2) PARENT(#TREEVIEW) SOURCE(#SECDESC)
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#LISTVIEW) DISPLAYPOSITION(1) HEIGHT(281) LEFT(6) PARENT(#GROUPBOX) TABPOSITION(1) TOP(72) WIDTH(377)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) CAPTION('Number ') CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#LISTVIEW) SOURCE(#EMPNO) WIDTH(20)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_2) CAPTION('First Name') CAPTIONTYPE(Caption) DISPLAYPOSITION(2) PARENT(#LISTVIEW) SOURCE(#GIVENAME) WIDTH(25)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_3) CAPTION('Last Name ') CAPTIONTYPE(Caption) DISPLAYPOSITION(3) PARENT(#LISTVIEW) SOURCE(#SURNAME) WIDTH(30)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_4) CAPTION('Salary') CAPTIONTYPE(Caption) DISPLAYPOSITION(4) PARENT(#LISTVIEW) SOURCE(#SALARY) WIDTH(20) WIDTHTYPE(Remainder)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GROUPBOX) CAPTION('Employees') DISPLAYPOSITION(1) HEIGHT(361) LEFT(240) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(104) VISIBLE(False) WIDTH(389)
DEFINE_COM CLASS(#DEPTDESC.Visual) NAME(#DEPTDESC) CAPTION('In Department') DISPLAYPOSITION(2) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(70) PARENT(#GROUPBOX) READONLY(True) TABPOSITION(2) TABSTOP(False) TOP(24) WIDTH(209)
DEFINE_COM CLASS(#SECDESC.Visual) NAME(#SECDESC) CAPTION('In Section ') DISPLAYPOSITION(3) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(70) PARENT(#GROUPBOX) READONLY(True) TABPOSITION(3) TABSTOP(False) TOP(48) WIDTH(209)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_VEMP) CAPTION('View Section Salary Details') DISPLAYPOSITION(3) ENABLED(False) LEFT(248) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(8) WIDTH(175)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_VDEP) CAPTION('View Department Salary Summary') DISPLAYPOSITION(5) ENABLED(False) LEFT(248) PARENT(#COM_OWNER) TABPOSITION(5) TABSTOP(False) TOP(40) WIDTH(175)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_VALL) CAPTION('View All Departments Salary Summary') DISPLAYPOSITION(4) LEFT(248) PARENT(#COM_OWNER) TABPOSITION(4) TOP(72) WIDTH(175)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_PEMP) CAPTION('Print Section salary Details') DISPLAYPOSITION(7) LEFT(432) PARENT(#COM_OWNER) TABPOSITION(7) TOP(8) WIDTH(185)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_PDEP) CAPTION('Print Department Salary Summary') DISPLAYPOSITION(8) HEIGHT(33) LEFT(437) PARENT(#COM_OWNER) TABPOSITION(8) TOP(40) WIDTH(180)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_PALL) CAPTION('Print All Departments Salary Summary') DISPLAYPOSITION(9) HEIGHT(18) LEFT(432) PARENT(#COM_OWNER) TABPOSITION(9) TOP(79) WIDTH(193)
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(2) HEIGHT(25) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(2) TOP(464) WIDTH(627)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#DEPTBOX) CAPTION('Departments and Sections ') DISPLAYPOSITION(6) HEIGHT(465) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(6) TOP(0) WIDTH(241)
* Active_X component details
DEFINE_COM CLASS(#va_excel) NAME(#S_EXCEL) REFERENCE(*DYNAMIC)
Define_Com Class(#va_excel.Worksheet) Name(#WorkSheet) Reference(*Dynamic)
* Work fields
DEFINE FIELD(#FNAME) TYPE(*CHAR) LENGTH(255)
DEFINE FIELD(#EMPLOYEES) REFFLD(#STD_NUM)
DEFINE FIELD(#SALARYTOT) LENGTH(*REFFLD *PLUS 2) REFFLD(#SALARY)
DEFINE FIELD(#SALARYAVE) REFFLD(#SALARY)
* Work fields to fill Excel spreadsheet
DEFINE FIELD(#W_TXT) TYPE(*CHAR) LENGTH(50)
DEFINE FIELD(#XLCOL) TYPE(*CHAR) LENGTH(2)
DEFINE FIELD(#XLCOLN) REFFLD(#DAY) DEFAULT(0)
DEFINE FIELD(#XLCELL) TYPE(*CHAR) LENGTH(4)
DEFINE FIELD(#W_ALF) TYPE(*CHAR) LENGTH(26)
DEFINE FIELD(#I1) REFFLD(#PRIFILRRN)
DEF_ARRAY NAME(#KOL) INDEXES(#I1) OVERLAYING(#W_ALF) TYPE(*CHAR) TOT_ENTRY(26) ENTRY_LEN(1)
*
********************************************************************************************************************
*
* Events
*
* Start of processing
EVTROUTINE handling(#com_owner.Initialize)
SET #com_owner caption(*component_desc)
* Fill array with all the letters of the alphabet
CHANGE FIELD(#W_ALF) TO(ABCDEFGHIJKLMNOPQRSTUVWXYZ)
* Fill tree view with department and section details
Select (#Deptment #DeptDesc) From_File(DepTab)
Select (#Section #SecDesc) From_File(SecTab) With_Key(#Deptment)
Add_Entry #TreeView
EndSelect
EndSelect
ENDROUTINE
* Handle an entry in the tree view getting focus by making the employee details appear on the right (level 2)
* or by making them disappear and by disabling some options
EVTROUTINE HANDLING(#TREEVIEW.ItemGotFocus) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS)
If '#Treeview.CurrentItem.Level = 2'
Set #BTN_VDEP Enabled(False)
Set #BTN_VEMP Enabled(True)
Clr_List #ListView
Select (#empno #SurName #GiveName #salary) From_File(PslMst1) with_key(#Deptment #Section)
Add_Entry #ListView
EndSelect
Set #GroupBox Visible(True)
Else
Set #BTN_VDEP Enabled(True)
Set #BTN_VEMP Enabled(False)
Set #GroupBox Visible(False)
EndIf
ENDROUTINE
*
* Handle request to send contents of employee list view to XL
* and view spreadsheet
*
EVTROUTINE HANDLING(#BTN_VEMP.Click)
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo1.xls')
CHANGE FIELD(#STD_FLAG) TO(V)
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(E)
ENDROUTINE
*
* Handle request to send contents of employee list view to XL
* and print spreadsheet
*
EVTROUTINE HANDLING(#BTN_PEMP.Click)
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo1.xls')
CHANGE FIELD(#STD_FLAG) TO(P)
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(E)
ENDROUTINE
*
* Handle request to send summary of all sections in current department to XL
* and view spreadsheet
*
EVTROUTINE HANDLING(#BTN_VDEP.Click)
CHANGE FIELD(#STD_FLAG) TO(V)
EXECUTE SUBROUTINE(AA_WRK_DEP)
ENDROUTINE
*
* Handle request to send summary of all sections in current department to XL
* and print spreadsheet
*
EVTROUTINE HANDLING(#BTN_PDEP.Click)
CHANGE FIELD(#STD_FLAG) TO(P)
EXECUTE SUBROUTINE(AA_WRK_DEP)
ENDROUTINE
*
* Handle request to send summary of all departments to XL
* and view spreadsheet
*
EVTROUTINE HANDLING(#BTN_VALL.Click)
CHANGE FIELD(#STD_FLAG) TO(V)
EXECUTE SUBROUTINE(AA_WRK_ALL)
ENDROUTINE
*
* Handle request to send summary of all departments to XL
* and print spreadsheet
*
EVTROUTINE HANDLING(#BTN_PALL.Click)
CHANGE FIELD(#STD_FLAG) TO(P)
EXECUTE SUBROUTINE(AA_WRK_ALL)
ENDROUTINE
*
********************************************************************************************************************
*
* Subroutines
*
* Accumulate salary details for selected depatment
*
SUBROUTINE NAME(AA_WRK_DEP)
Def_List #DeptSum (#DeptDesc #secdesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
Select fields(#Section #SecDesc) from_file(Sectab) with_key(#deptment)
Change (#Employees #SalaryTot #SalaryAve) 0
Select Fields(#Salary) From_File(PslMst1) With_Key(#Deptment #Section)
Change #SalaryTot '#SalaryTot + #Salary'
Change #Employees '#Employees + 1'
EndSelect
if '#Employees > 0'
Change #SalaryAve '#SalaryTot / #Employees'
Endif
Add_Entry #DeptSum
Endselect
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo2.xls')
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(D)
Clr_List #DeptSum
ENDROUTINE
*
* Accumulate salary details for all depatments
*
SUBROUTINE NAME(AA_WRK_ALL)
Def_List #AllSum (#DeptDesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
Select fields(#Deptment #DeptDesc) from_file(DepTab)
Change (#Employees #SalaryTot #SalaryAve) 0
Select Fields(#Salary) From_File(PslMst1) With_Key(#Deptment)
Change #SalaryTot '#SalaryTot + #Salary'
Change #Employees '#Employees + 1'
EndSelect
if '#Employees > 0'
Change #SalaryAve '#SalaryTot / #Employees'
Endif
Add_Entry #AllSum
Endselect
* Set Excel spreadsheet name (it MUST already exist as it will not be created)
CHANGE FIELD(#FNAME) TO('C:\Temp\Demo3.xls')
EXECUTE SUBROUTINE(BA_EXCEL) WITH_PARMS(A)
Clr_List #AllSum
ENDROUTINE
SUBROUTINE NAME(BA_EXCEL) PARMS(#LTYP)
DEFINE FIELD(#LTYP) TYPE(*CHAR) LENGTH(1) DESC('List type')
Set_Ref Com(#S_Excel) To(*Create_As #va_excel)
* Open the workbooks
Invoke Method(#s_Excel.Workbooks.Open) Filename(#Fname)
* Activate the spreadsheet (in this example it is called Sheet1)
Set_Ref Com(#Worksheet) To(*Dynamic #S_Excel.Worksheets.Item<'Sheet1'>)
Invoke Method(#Worksheet.Activate)
* Clear out the previous data
Invoke Method(#Worksheet.Cells.ClearContents)
* Initialise column number field of cell
change field(#XLCOLN #XLCOL) TO(*NULL)
* Process appropriate list containing the detail
CASE OF_FIELD(#LTYP)
WHEN VALUE_IS('= A')
EXECUTE SUBROUTINE(CA_ALL_LST)
WHEN VALUE_IS('= D')
EXECUTE SUBROUTINE(CA_DEP_LST)
WHEN VALUE_IS('= E')
EXECUTE SUBROUTINE(CA_EMP_LST)
ENDCASE
* Save spreadsheet without messages
Set #S_EXCEL DisplayAlerts(False)
invoke method(#S_EXCEL.Save)
Set #S_EXCEL DisplayAlerts(True)
* Display spreadsheet if View was selected
CASE OF_FIELD(#STD_FLAG)
WHEN VALUE_IS('= V')
Set #S_EXCEL Visible(True)
WHEN VALUE_IS('= P')
Invoke Method(#Worksheet.Printout)
ENDCASE
ENDROUTINE
* Process the browselist of all departments
SUBROUTINE NAME(CA_ALL_LST)
* Process the list containing data
SELECTLIST NAMED(#AllSum)
EXECUTE SUBROUTINE(CA_FIL_SHT) WITH_PARMS(A)
ENDSELECT
ENDROUTINE
SUBROUTINE NAME(CA_DEP_LST)
* Process the list containing department data
SELECTLIST NAMED(#DeptSum)
EXECUTE SUBROUTINE(CA_FIL_SHT) WITH_PARMS(D)
ENDSELECT
ENDROUTINE
* Process the browselist of employees
SUBROUTINE NAME(CA_EMP_LST)
* Process the list containing data
SELECTLIST NAMED(#ListView)
EXECUTE SUBROUTINE(CA_FIL_SHT) WITH_PARMS(E)
ENDSELECT
ENDROUTINE
* Fill the spreadsheet
SUBROUTINE NAME(CA_FIL_SHT) PARMS(#LTYP)
* Initialise array index for column letter of cell
Change field(#I1) to(*null)
* Increase column number field of cell and make it alpha for TCONCAT
change field(#XLCOLN) TO('#XLCOLN + 1')
IF ('#XLCOLN < 10')
SUBSTRING FIELD(#XLCOLN 2 1) INTO_FIELD(#XLCOL 1 1)
ELSE
IF ('#XLCOLN < 100')
SUBSTRING FIELD(#XLCOLN) INTO_FIELD(#XLCOL)
ENDIF
ENDIF
* Move all fields to spreadsheet
CASE OF_FIELD(#LTYP)
WHEN VALUE_IS('= A')
* Def_List #AllSum (#DeptDesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#DEPTDESC)
SUBSTRING FIELD(#Employees) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salarytot) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salaryave) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
WHEN VALUE_IS('= D')
* Def_List #DeptSum (#DeptDesc #secdesc #Employees #SalaryTot #SalaryAve) type(*working) entrys(9999)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Deptdesc)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Secdesc)
SUBSTRING FIELD(#Employees) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salarytot) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
SUBSTRING FIELD(#Salaryave) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
WHEN VALUE_IS('= E')
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Empno)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Surname)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#Givename)
SUBSTRING FIELD(#Salary) INTO_FIELD(#W_TXT)
EXECUTE SUBROUTINE(CA_FIL_CEL) WITH_PARMS(#W_TXT)
ENDCASE
ENDROUTINE
* Fill the individual cells
SUBROUTINE NAME(CA_FIL_CEL) PARMS((#W_TXT *RECEIVED))
* Parameter received is text for the cell
* Increase array index for column letter of cell
change field(#I1) TO('#I1 + 1')
* Determine cell identication (e.g. A1, X6 etc.)
USE BUILTIN(TCONCAT) WITH_ARGS(#KOL#I1 #XLCOL) TO_GET(#XLCELL)
* Move text field value to appropriate cell
Set #S_EXCEL.Range<#XLCELL> Value(#W_TXT)
ENDROUTINE
END_COM