Code-Bin #457

untitled VisualFoxPro Code
Posted by: ancky | January 21, 2010 @ 1:09am

VisualFoxPro Code

**************************************************************************
** Method Name  :   main
** Author       :   Ramos, E. U.
** Creation Date:   08/27/2004
**
**
** Modification History:
** --------------------
**04/21/2009 FDF included RANK on the payroll Report
**************************************************************************
local lcReccount
private pcSection,pcJobtype,pnSheet1Ctr,pnSectSheetCtr,pnGroupRowStart

This.gather_data()

* Create Excel application
if type('goXLApp')<>'O' and goXLApp = .f.
	wait window nowait noclear "Starting Excel ..."
	goXLApp=createobject("excel.application")
else
	if type('goXLApp.Activewindow') = 'O' and goXLApp.Activewindow <> .null.
		goXLApp.Activewindow.close
	endif
	if !goXLApp.visible
		goXLApp.quit
		goXLApp=createobject("excel.application")
	else
		goXLApp=getobject(,"excel.application")
	endif
endif

with goXLApp
	if .caption <> This.caption
		.caption = This.caption+" "+.caption
	endif
	.workbooks.add
	.DisplayAlerts = .f.
	.sheets(1).name = "Employee Listing" &&alltrim(crDept.DEPT_CODE)
	if type('.worksheets("sheet2")') = 'O'
		.worksheets("sheet2").delete
	endif
	if type('.worksheets("sheet3")') = 'O'
		.worksheets("sheet3").delete
	endif
endwith

* Report Header & Page setup
with goXLApp.ActiveSheet.PageSetup
    .LeftMargin = goXLApp.InchesToPoints(0.75)
    .RightMargin = goXLApp.InchesToPoints(0.75)
    .TopMargin = goXLApp.InchesToPoints(1)
    .BottomMargin = goXLApp.InchesToPoints(1)
    .HeaderMargin = goXLApp.InchesToPoints(0.5)
    .FooterMargin = goXLApp.InchesToPoints(0.5)
    .LeftHeader ="Run date >> " +mdy(date())+chr(10)+"Page no.>> &P"
	.Orientation = 1 && Portrait
	.Papersize = 9 && xlPaperA4    1 = 8.5*11
	.CenterHorizontally = .t.
	.PrintTitleRows = "$1:$1"
	.zoom = .f.
	.FitToPagesWide = 1
	.FitToPagesTall = .f.
endwith

* 1st Sheet Columns

if thisform.check3.value = 1
		This.inc_rank(Thisform.check1.value)
	else
		This.set_columns(Thisform.check1.value)
endif

store 2 to pnSheet1Ctr,pnSectSheetCtr

select crPayslip
lcReccount =  alltrim(str(reccount()))
go top
*!*	do while !eof('crPayslip')
*!*	set step on
	pnGrouprowstart=pnSheet1Ctr
Scan
	wait window nowait "Transfering data ..."+crPayslip.E_EMPNO

select Jobtype
	locate for JOBTYPE = crPayslip.JOBTYPE
	
	select crTimesht
	locate for E_EMPNO = crPayslip.E_EMPNO

select crOvertime
	locate for E_EMPNO = crPayslip.E_EMPNO
	
	if thisform.check3.value = 1
		This.superRank(thisform.check1.value)
	else
		This.sheet1_details(Thisform.check1.value)
	endif

pnSheet1Ctr = pnSheet1Ctr + 1
endscan
*!*			This.section_totals()
		******************
	goXLApp.sheets(goXLApp.worksheets.count).select

* Headcount
	goXLApp.ActiveSheet.cells(pnSheet1Ctr,1).NumberFormat = "#,##0.00"		
	goXLApp.ActiveSheet.cells(pnSheet1Ctr,1).formula = "=counta('Employee Listing'!"+goXLApp.ActiveSheet.cells(pnGroupRowStart,1).address(.f.,.f.)+":"+goXLApp.ActiveSheet.cells(pnSheet1Ctr-1,1).address(.f.,.f.)+")"

IF ThisForm.Check2.VALUE = 1
		lnCounter = 5
	ELSE
		lnCounter = 3
	ENDIF
	* Amounts
	lnCol_count = val(This.last_col)
	for lnCtr = lnCounter to lnCol_count
		goXLApp.ActiveSheet.cells(pnSheet1Ctr,lnCtr).formula = "=sum('Employee Listing'!"+goXLApp.ActiveSheet.cells(pnGroupRowStart,lnCtr).address(.f.,.f.)+":"+goXLApp.ActiveSheet.cells(pnSheet1Ctr-1,lnCtr).address(.f.,.f.)+")"
	endfor

goXLApp.ActiveSheet.cells.EntireColumn.AutoFit
	******************
	pnSectSheetCtr = pnSectSheetCtr + 1
*!*	enddo

goXLApp.sheets(1).select
goXLApp.ActiveSheet.cells.EntireColumn.AutoFit
wait clear
goXLApp.visible = .t.

* ito ung Gather_data()
select Payslip
locate for SPERIOD = ldSperiod
if found()
	select a.*,JOBTYPE,NAME,TAX_UNIT,GL_ACCOUNT,RANK ;&&included RANK by FDF April 21, 2009
	from Payslip a ;
		inner join Empmas b on a.E_EMPNO = b.E_EMPNO ;
	order by NAME,a.SECTION_CO,JOBTYPE,a.E_EMPNO ;
	into cursor crPayslip
	sele crPayslip
	index on NAME to a

select distinct a.EARNCODE ;
	from Earndetl a;
		inner join Earncode b on a.EARNCODE = b.EARNCODE ;
	where a.E_EMPNO in (select E_EMPNO from crPayslip) and upper(POSTED) = 'Y' and upper(TAXABLE) = 'Y';
	order by a.EARNCODE ;
	into cursor crTaxEarnlist
	Sele crTaxEarnlist
	index on EARNCODE to c
	
	
	select distinct DEDCODE ;
	from Ded_detl a;
		inner join Empmas b on a.E_EMPNO = b.E_EMPNO ;
	where upper(POSTED) = 'Y' ;
	order by DEDCODE ;
	into cursor crDedlist
	Sele crDedlist
	index on DEDCODE to d

select a.E_EMPNO,EARNCODE,sum(AMOUNT) as AMOUNT ;
	from Earndetl a;
		inner join crPayslip b on a.E_EMPNO = b.E_EMPNO ;
	where upper(POSTED) = 'Y' ;
	order by a.E_EMPNO,EARNCODE ;
	group by a.E_EMPNO,EARNCODE ; && Jan 25, 2005 by RLA
	into cursor crEarndetl
	Sele crEarndetl
	index on E_EMPNO+EARNCODE to e

select a.E_EMPNO,DEDCODE,sum(AMOUNT) as AMOUNT ;
	from Ded_detl a;
		inner join crPayslip b on a.E_EMPNO = b.E_EMPNO ;
	where upper(POSTED) = 'Y' ;
	order by a.E_EMPNO,DEDCODE ;
	group by a.E_EMPNO,DEDCODE ; && Jan 25, 2005 by RLA
	into cursor crDed_detl
	sele crDed_detl
	index on E_EMPNO+DEDCODE to f
	
	select a.* ;
	from Timesht a;
		inner join crPayslip b on a.E_EMPNO = b.E_EMPNO ;
	where DISREGARD <> 'Y' ;
	order by a.E_EMPNO ;
	into cursor crTimesht
	sele crTimesht
	index on E_EMPNO to g

select a.* ;
	from Overtime a;
		inner join crPayslip b on a.E_EMPNO = b.E_EMPNO ;
	where DISREGARD <> 'Y' ;
	order by a.E_EMPNO ;
	into cursor crOvertime
	Sele crOvertime
	index on E_EMPNO to h
endif

* tpos papasok sya sa isang method ito naman gagawin
* ito ung This.superrank()
select crNonTaxEarnlist
scan
	select crEarndetl
	locate for E_EMPNO+EARNCODE = crPayslip.E_EMPNO+crNonTaxEarnlist.EARNCODE
	This.is_uploaded(.f.,@lnCtr,crNonTaxEarnlist.EARNCODE)
endscan

select crTaxEarnlist
scan
	select crEarndetl
	locate for E_EMPNO+EARNCODE = crPayslip.E_EMPNO+crTaxEarnlist.EARNCODE
	This.is_uploaded(.f.,@lnCtr,crTaxEarnlist.EARNCODE)
endscan

select crDedlist
scan
	select crDed_detl
	locate for E_EMPNO+DEDCODE = crPayslip.E_EMPNO+crDedlist.DEDCODE
	goXLApp.ActiveSheet.cells(pnSheet1Ctr,lnCtr).value = iif(found(),AMOUNT,0)
	lnCtr = lnCtr + 1
endscan

Syntax Highlighting

[Open in new window]

Author Comments

none

Rating

4.46 / 8
46 Votes