Make report to Excel by VFP

The report will be like this. (Look up)
This is just a simple report. report nerace in accounting.... to excel by VFP
This sample of Program.
SET SAFETY OFF
SET TALK OFF

IF !USED("r_coa")
USE r_coa IN 0 SHARED
ENDIF

IF !USED("tm_gl")
USE tm_gl IN 0 SHARED
ENDIF

IF !USED("td_gl")
USE td_gl IN 0 SHARED
ENDIF

IF !USED("gl_year")
USE gl_year IN 0 SHARED
ENDIF

m.year_num = ALLTRIM(STR(thisform.spinner1.Value))
xMth_num = thisform.combo1.ListIndex
m.mth_des = ALLTRIM(thisform.combo1.Value)
m.last_year = ALLTRIM(STR(thisform.spinner1.Value - 1))

IF LEN(ALLTRIM(STR(xmth_num))) = 1
m.mth_num = "0" + ALLTRIM(STR(xmth_num))
ELSE
m.mth_num = ALLTRIM(STR(xmth_num))
ENDIF
percent_done = "0"
** Inditifikasi data coa
CREATE CURSOR tmp_coa(Tcoa_cde c(3), Tcoa_des c(50))
SELECT * from r_coa WHERE ALLTRIM(right(acc_cde, 3)) = "000" AND ALLTRIM(right(acc_cde, 5)) <> "00000" AND ALLTRIM(LEFT(ACC_CDE, 1)) <> "4" AND LEFT(ALLTRIM(acc_cde), 2) <> "36" ORDER BY acc_cde INTO CURSOR cur_rcoa
DO WHILE !EOF()
IF LEFT(ALLTRIM(cur_rcoa.acc_cde), 2) = "13" OR LEFT(ALLTRIM(cur_rcoa.acc_cde), 2) = "1B"
oTmp_coa = LEFT(ALLTRIM(cur_rcoa.acc_cde), 3)
ELSE
oTmp_coa = LEFT(ALLTRIM(cur_rcoa.acc_cde), 2)
ENDIF
SELECT tmp_coa
INDEX on Tcoa_cde TO Tcoa_cde
SET ORDER TO Tcoa_cde
SEEK(ALLTRIM(oTmp_coa))
IF !FOUND()
INSERT INTO tmp_coa(Tcoa_cde, Tcoa_des);
values(LEFT(ALLTRIM(cur_rcoa.acc_cde), 3), ALLTRIM(cur_rcoa.acc_des))
ENDIF
SELECT cur_rcoa
SKIP
ENDDO

CREATE CURSOR tmp_gl(xCoa_cde c(5), xCoa_des c(50), xCoa_amt n(19, 2), grp_clm c(1))
SELECT tmp_coa
tot_count = RECCOUNT()
j = 1
GO TOP
DO WHILE !EOF()
val_gen = 1
cya_amt = 0
tmp_dr_amt = 0
tmp_cr_amt = 0
* Simpan dan baca nilai bulan berjalan
DO CASE
CASE LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) = "13" OR LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) = "1B"
SELECT * FROM tm_gl WHERE mth_num <= m.mth_num AND year_num = m.year_num AND LEFT(ALLTRIM(acc_cde), 3) = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 3) ORDER BY acc_cde INTO CURSOR cur_tmgl1
SUM cur_tmgl1.cya_cr_amt, cur_tmgl1.cya_dr_amt TO tmp_cr_amt, tmp_dr_amt
IF LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) = "1B"
o_coa_cde = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 3) + "AB"
ELSE
o_coa_cde = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 3) + "AC"
ENDIF
oGrp_clm = "A"
OTHERWISE
IF LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) <> "36"
SELECT * FROM tm_gl WHERE mth_num <= m.mth_num AND year_num = m.year_num AND LEFT(ALLTRIM(acc_cde), 2) = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) ORDER BY acc_cde INTO CURSOR cur_tmgl3
SUM cur_tmgl3.cya_cr_amt, cur_tmgl3.cya_dr_amt TO tmp_cr_amt, tmp_dr_amt
o_coa_cde = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 3) + "AB"
oGrp_clm = "P"
ENDIF
ENDCASE
****

* Simpan dan baca saldo awal
DO CASE
CASE LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) = "13" OR LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) = "1B"
SELECT * FROM gl_year WHERE year_num = "2006" AND LEFT(ALLTRIM(acc_cde), 3) = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 3) ORDER BY acc_cde INTO CURSOR cur_glyear
SUM cur_glyear.year_amt TO cyo_amt
OTHERWISE
SELECT * FROM gl_year WHERE year_num = "2006" AND LEFT(ALLTRIM(acc_cde), 2) = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 2) ORDER BY acc_cde INTO CURSOR cur_glyear
SUM cur_glyear.year_amt TO cyo_amt
ENDCASE
****
cya_amt = (tmp_dr_amt - tmp_cr_amt) + cyo_amt
* messagebox(STR(cya_amt) + "*" +STR(tmp_cr_amt) + "*" + str(tmp_dr_amt) +"*" + STR( cyo_amt))

IF LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 1) <> "1"
o_coa_cde = LEFT(ALLTRIM(tmp_coa.Tcoa_cde), 3) + "BB"
val_gen = -1
xcya_amt = cya_amt * val_gen
oGrp_clm = "P"
ELSE
xcya_amt = cya_amt
oGrp_clm = "A"
ENDIF

IF cya_amt <> 0
INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values(o_coa_cde,ALLTRIM(tmp_coa.Tcoa_des) , xcya_amt, oGrp_clm)
ENDIF

rec_done = (j / tot_count)
bar_done = rec_done * 100
scl_bar = rec_done * 361
percent_done = TRANSFORM(bar_done, '999')
thisform.progressbar.BackStyle = 1
Thisform.ProgressBar.Width = scl_bar
ThisFORM.ProgressPercent.Caption = percent_done + '%'
THISFORM.lblprogress.caption = "Proses Identifikasi data " + ALLTRIM(o_coa_cde)
INKEY(0.001)
j = j + 1
SELECT tmp_coa
SKIP
ENDDO

* Simpan Nilai Ekuitas
SELECT * FROM r_coa WHERE LEFT(ALLTRIM(acc_cde), 2) = "36" AND acc_cde <> "360000" AND acc_cde <> "360003" ORDER BY acc_cde INTO CURSOR coa_laba
i = 0
DO WHILE !EOF()
IF ALLTRIM(coa_laba.acc_cde) = "360004"
SELECT * FROM tm_gl WHERE VAL(mth_num) < year_num =" m.year_num" acc_cde =" ALLTRIM(coa_laba.acc_cde)">
add_val = -1
ELSE
IF ALLTRIM(coa_laba.acc_cde) = "360002"
SELECT * FROM tm_gl WHERE VAL(mth_num) = VAL(m.mth_num) AND year_num = m.year_num AND acc_cde = ALLTRIM(coa_laba.acc_cde) INTO CURSOR laba_gl
add_val = 1
ELSE
SELECT * FROM tm_gl WHERE VAL(mth_num) <= VAL(m.mth_num) AND year_num = m.year_num AND acc_cde = ALLTRIM(coa_laba.acc_cde) INTO CURSOR laba_gl
add_val = -1
ENDIF
ENDIF

SUM laba_gl.cya_dr_amt, laba_gl.cya_cr_amt TO laba_dr_amt, laba_cr_amt
i = i + 1
cya_amt = 0
xcya_amt = 0
saldo_laba = 0
select * FROM gl_year WHERE year_num = "2006" AND acc_cde = ALLTRIM(coa_laba.acc_cde) INTO CURSOR cur_cyo
SUM cur_cyo.year_amt TO saldo_laba
cya_amt = (laba_dr_amt - laba_cr_amt) + saldo_laba
o_coa_cde = "36" + ALLTRIM(STR(i)) + "BB"
IF cya_amt <> 0
xcya_amt = cya_amt * add_val
IF ALLTRIM(coa_laba.acc_cde) = "360002"
oTcoa_des = "LABA RUGI BULAN BERJALAN"
ELSE
oTcoa_des = ALLTRIM(coa_laba.acc_des)
ENDIF
INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values(o_coa_cde, oTcoa_des, xcya_amt, "P")
ENDIF
SELECT coa_laba
SKIP
ENDDO

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("000WW", "A K T I V A", "A")

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("100AA", "AKTIVA LANCAR", "A")

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("130AB", "PIUTANG DAGANG", "A")

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("188AA", "AKTIVA TIDAK LANCAR", "A")

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("220BA", "KEWAJIBAN LANCAR", "P")

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("270BA", "KEWAJIBAN TIDAK LANCAR", "P")

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("310BA", "EKUITAS", "P")

** Simpan total aktiva lancar
SELECT * FROM tmp_gl WHERE VAL(substr(ALLTRIM(xCoa_cde),1,2)) <= 17 AND TYPE(substr(ALLTRIM(xCoa_cde),2,1)) = "N" ORDER BY XcOA_CDE INTO CURSOR osub_tbl1
SUM osub_tbl1.xCoa_amt TO tot_act_lncar
INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values("177XX", "TOTAL AKTIVA LANCAR", tot_act_lncar, "A")

** Simpan total akviva tidak lancar
SELECT * FROM tmp_gl WHERE (VAL(left(ALLTRIM(xCoa_cde),2)) <= 11 OR VAL(left(ALLTRIM(xCoa_cde),1)) <>
SUM osub_tbl2.xCoa_amt TO tot_tdk_lncar1

SELECT * FROM tmp_gl WHERE VAL(left(ALLTRIM(xCoa_cde),2)) >= 18 and VAL(left(ALLTRIM(xCoa_cde),1)) <>
SUM osub_tbl3.xCoa_amt TO tot_tdk_lncar2
tot_tdk_lncar = tot_tdk_lncar1 + tot_tdk_lncar2

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values("1VVXX", "TOTAL AKTIVA TIDAK LANCAR", tot_tdk_lncar, "A")

tot_aktiva = tot_act_lncar + tot_tdk_lncar
INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values("1YYYY", "TOTAL AKTIVA", tot_aktiva, "A")

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, grp_clm);
values("200WW", "P A S S I V A", "P")

** Simpan total Kewajiban Lancar
SELECT * FROM tmp_gl WHERE VAL(left(ALLTRIM(xCoa_cde),2)) >= 20 AND VAL(left(ALLTRIM(xCoa_cde),2)) <= 26 INTO CURSOR osub_tbl4
SUM osub_tbl4.xCoa_amt TO tot_pasiva_lncar
INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values("266XX", "TOTAL KEWAJIBAN LANCAR", tot_pasiva_lncar, "P")

** Simpan total Kewajiban Tidak Lancar
SELECT * FROM tmp_gl WHERE (VAL(left(ALLTRIM(xCoa_cde),2)) >= 27 AND VAL(left(ALLTRIM(xCoa_cde),1)) <>
SUM osub_tbl5.xCoa_amt TO tot_pas_tdk_lncar1

SELECT * FROM tmp_gl WHERE (VAL(left(ALLTRIM(xCoa_cde),2)) <= 20 AND VAL(left(ALLTRIM(xCoa_cde),1)) > 1) ORDER BY XcOA_CDE INTO CURSOR osub_tbl6
SUM osub_tbl6.xCoa_amt TO tot_pas_tdk_lncar2
tot_pas_tdk_lncar = tot_pas_tdk_lncar1 + tot_pas_tdk_lncar2

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values("2VVXX", "TOTAL KEWAJIBAN TIDAK LANCAR", tot_PAS_tdk_lncar, "P")

** Simpan total ekuitas
SELECT * FROM tmp_gl WHERE VAL(left(ALLTRIM(xCoa_cde),1)) = 3 ORDER BY XcOA_CDE INTO CURSOR osub_tbl7
SUM osub_tbl7.xCoa_amt TO tot_ekuitas

INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values("3VVXX", "TOTAL EKUITAS", tot_ekuitas, "P")

** Simpan total PASSIVA
tot_passiva = tot_pasiva_lncar + tot_pas_tdk_lncar + tot_ekuitas
INSERT INTO tmp_gl(xCoa_cde, xCoa_des, xCoa_amt, grp_clm);
values("3YYYY", "TOTAL PASSIVA", tot_passiva, "P")
IF thisform.optiongroup1.option1.Value = 1
MESSAGEBOX("Proses selesai dengan normal", 16, "Perhatian!!")
thisform.command2.Caption = "Selesai"
SELECT * FROM tmp_gl ORDER BY XcOA_CDE INTO CURSOR tbl_nrc
REPORT FORM curr_dir + "\report\rpt_neraca" PREVIEW
ELSE
oExcel_nme = "NERACA " + ALLTRIM(m.com_des) + " - " + ALLTRIM(m.mth_des) + " " + ALLTRIM(m.year_num) + ".xls"
oExcel = CreateObject("Excel.Application")
if vartype(oExcel) != "O"
* could not instantiate Excel object
* show an error message here
return .F.
ENDIF

oWorkbook = oExcel.Application.Workbooks.Open("C:\temp\foobar.xls")
i = 3
j = 3
oExcel.Selection.font.colorindex = 0
oExcel.Selection.font.bold = .F.
SELECT * FROM tmp_gl ORDER BY XcOA_CDE INTO CURSOR tbl_nrc
tot_count = RECCOUNT()
v = 1
DO WHILE !EOF()
i = i + 1
*** Print AKTIVA
IF ALLTRIM(tbl_nrc.grp_clm) = "A"
IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "WW"
b1 = "B" + ALLTRIM(STR(i))
oExcel.Range(b1).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(b1).font.FontStyle = "Bold"
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "AA"
c1 = "C" + ALLTRIM(STR(i))
oExcel.Range(c1).Value = ALLTRIM(tbl_nrc.xCoa_des)
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "AB"
d1 = "D" + ALLTRIM(STR(i))
h1 = "H" + ALLTRIM(STR(i))
oExcel.Range(d1).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(H1).Value = tbl_nrc.xCoa_AMT
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "AC"
E1 = "E" + ALLTRIM(STR(i))
H1 = "H" + ALLTRIM(STR(i))
oExcel.Range(E1).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(H1).Value = tbl_nrc.xCoa_AMT
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "XX"
i = i + 1
c2 = "C" + ALLTRIM(STR(i))
H1 = "H" + ALLTRIM(STR(i))
oExcel.Range(C2).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(H1).Value = tbl_nrc.xCoa_AMT
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "YY"
i = i + 1
b2 = "B" + ALLTRIM(STR(i))
H1 = "H" + ALLTRIM(STR(i))
oExcel.Range(B2).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(H1).Value = tbl_nrc.xCoa_AMT
oExcel.Range(B2).font.FontStyle = "Bold"
oExcel.Range(H1).font.FontStyle = "Bold"
s = i
ENDIF
ENDIF

*** Print PASSIVA
IF ALLTRIM(tbl_nrc.grp_clm) = "P"
j = j + 1
IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "WW"
J1 = "J" + ALLTRIM(STR(j))
oExcel.Range(J1).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(J1).font.FontStyle = "Bold"
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "BA"
K1 = "K" + ALLTRIM(STR(j))
oExcel.Range(K1).Value = ALLTRIM(tbl_nrc.xCoa_des)
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "BB"
L1 = "L" + ALLTRIM(STR(j))
N1 = "N" + ALLTRIM(STR(j))
oExcel.Range(L1).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(N1).Value = tbl_nrc.xCoa_AMT
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "XX"
j = j + 1
K2 = "K" + ALLTRIM(STR(j))
N2 = "N" + ALLTRIM(STR(j))
oExcel.Range(K2).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(N2).Value = tbl_nrc.xCoa_AMT
ENDIF

IF RIGHT(ALLTRIM(tbl_nrc.xCoa_cde), 2) = "YY"
L2 = "L" + ALLTRIM(STR(s))
N3 = "N" + ALLTRIM(STR(s))
oExcel.Range(L2).Value = ALLTRIM(tbl_nrc.xCoa_des)
oExcel.Range(N3).Value = tbl_nrc.xCoa_AMT
oExcel.Range(L2).font.FontStyle = "Bold"
oExcel.Range(N3).font.FontStyle = "Bold"
ENDIF
ENDIF

oExcel.RANGE("B1:N1").Merge && Merge dari B1 to N1
oExcel.RANGE("B1:N1").VALUE = ALLTRIM(M.COM_DES) && Colom Merge dengan isi nama pt
oExcel.Range("B1:N1").HorizontalAlignment = 3 && Bikin ketengah
oExcel.Range("B1:N1").font.size = 16
oExcel.Range("B1:N1").font.FontStyle = "Bold"


oExcel.RANGE("B2:N2").Merge && Merge dari B1 to N1
oExcel.RANGE("B2:N2").VALUE = "NERACA - " + ALLTRIM(M.MTH_DES) + " " + ALLTRIM(M.YEAR_NUM) && Colom Merge dengan isi nama pt
oExcel.Range("B2:N2").HorizontalAlignment = 3 &&
oExcel.Range("B2:N2").font.size = 14
oExcel.Range("B2:N2").font.FontStyle = "Bold"

oExcel.Worksheets("Sheet1").Columns("N").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
oExcel.Worksheets("Sheet1").Columns("H").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
oExcel.Worksheets("Sheet1").Columns("A").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("B").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("C").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("D").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("F").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("G").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("I").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("J").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("K").ColumnWidth = 3
oExcel.Worksheets("Sheet1").Columns("M").ColumnWidth = 3
oWorkbook.Save()
rec_done = (v / tot_count)
bar_done = rec_done * 100
scl_bar = rec_done * 361
percent_done = TRANSFORM(bar_done, '999')
thisform.progressbar.BackStyle = 1
Thisform.ProgressBar.Width = scl_bar
ThisFORM.ProgressPercent.Caption = percent_done + '%'
THISFORM.lblprogress.caption = "Transfer data Ke Excel " + ALLTRIM(xCoa_des)
INKEY(0.001)
v = v + 1
SELECT tbl_nrc
SKIP
ENDDO
MESSAGEBOX("Proses selesai dengan normal, Silahkan open data excel", 16, "Perhatian!!")
thisform.command2.Caption = "Selesai"
oWorkbook.DisplayAlerts = .F.
oWorkbook.SaveAs("c:\temp\" + oExcel_nme)
oExcel.quit()
ENDIF

Read More......

Export caracter dbf to Memo in VFP

I have a sample logic to export caracter dbf to Memo, this sample in VFP..this is just a simple sample..
IF !USED("c:\dev\cetak\tm_csh_m.dbf")
USE c:\dev\cetak\tm_csh_m.dbf IN 0 SHARED
endif
IF !USED("t:\sikp\dat\tm_csh")
USE t:\sikp\dat\tm_csh IN 0 SHARED
ENDIF
SCATTER MEMVAR blank
SELECT tm_csh
SCATTER MEMVAR memo
DO WHILE !EOF()
SELECT * from tm_csh_m WHERE no_csh == ALLTRIM(tm_csh.csh_num) INTO CURSOR tmp_mem
DO WHILE !EOF()
replace tm_csh.csh_des WITH ALLTRIM(tmp_mem.des) + chr(13) ADDITIVE
SELECT tmp_mem
SKIP
ENDDO
SELECT tm_csh
skip
ENDDO

Additive = for add caracter to field momend, this function just to use in memo field.

Read More......