Exsport DBF to Excell

Saya lampirkan teknik coding untuk exsport data dari DBF ke Microsoft Excell Application

FUNCTION DBFWNERACA

Local oExcel,oWorkBook,oSheet
Local nRow,nProgres,aPos,x,nValue
Local ttdebet := 0
Local lRet := .F.

wneraca.Progress_1.Value := 0

IF OPENTABLES(cDRV+”NERACA”,.F.)
// SET INDEX TO (cDRV+”GLMAS4″),(cDRV+”GLMAS”)
ELSE
RETURN
ENDIF

STANGGAL := NERACA->TANGGAL
STHN   := SUBSTR(DTOS(STANGGAL),1,4)
SBULAN := SUBSTR(DTOS(STANGGAL),5,2)
STGL   := SUBSTR(DTOS(STANGGAL),7,2)

DO CASE
CASE MONTH(STANGGAL) == 1
CMONTH := “January”
CASE MONTH(STANGGAL) == 2
CMONTH := “February”
CASE MONTH(STANGGAL) == 3
CMONTH := “Maret”
CASE MONTH(STANGGAL) == 4
CMONTH := “April ”
CASE MONTH(STANGGAL) == 5
CMONTH := “M e i”
CASE MONTH(STANGGAL) == 6
CMONTH := “J u n i”
CASE MONTH(STANGGAL) == 7
CMONTH := “J u l i”
CASE MONTH(STANGGAL) == 8
CMONTH := “Agustus”
CASE MONTH(STANGGAL) == 9
CMONTH := “September”
CASE MONTH(STANGGAL) == 10
CMONTH := “Oktober”
CASE MONTH(STANGGAL) == 11
CMONTH := “November”
CASE MONTH(STANGGAL) == 12
CMONTH := “Desember”
ENDCASE

oExcel:= CreateObject(“Excel.Application” )
If ole2TxtError()!=’S_OK’
lRet := .F.
Msginfo(‘Excel Application Not Installed’,’Perhatian.!!!’)
Return
else
oExcel:Quit()
Endif

oExcel:Workbooks:Add()
oSheet:=oExcel:Activesheet
osheet:cells(1,1):value := “PT.YOKATTA INDONESIA”
osheet:cells(1,1):Font:Size:=8
oSheet:cells(1,1):Font:Bold:=.T.
oSheet:cells(1,1):Font:Underline:=.T.

oSheet:cells(2,2):Value := “BALANCE SHEET REPORT”
osheet:cells(2,2):Font:Size:=18
oSheet:cells(2,2):Font:Bold:=.T.
//oSheet:cells(2,2):Font:Underline:=.T.
oSheet:range(“B1:E1”):select()
oSheet:range(“a2:E2”):merge()
oSheet:range(“a2:E2”):horizontalalignment:= 7

oSheet:cells(3,3):Value := “As Ended : ” + STGL+” “+cmonth+” “+STHN
osheet:cells(3,3):Font:Size:=12
oSheet:cells(3,3):Font:Bold:=.T.
oSheet:cells(3,3):Font:Underline:=.T.
oSheet:range(“c1:E1”):select()
oSheet:range(“a3:E3”):merge()
oSheet:range(“a3:E3″):horizontalalignment:= 7

&& Header Report
osheet:cells(5,1):value :=”No.”
osheet:cells(5,1):Font:Size:=12
oSheet:cells(5,1):Font:Bold:=.T.

osheet:cells(5,2):value :=”No.Perkiraan”
osheet:cells(5,2):Font:Size:=12
oSheet:cells(5,2):Font:Bold:=.T.
osheet:cells(5,2):columnWidth := 17.14

osheet:cells(5,3):value :=”Nama Perkiraan ”
osheet:cells(5,3):Font:Size:=12
oSheet:cells(5,3):Font:Bold:=.T.
osheet:cells(5,3):columnWidth := 32.86
oSheet:range(“c5:c5″):horizontalalignment:= 7

osheet:cells(5,4):value :=”Debet”
osheet:cells(5,4):Font:Size:=12
oSheet:cells(5,4):Font:Bold:=.T.
oSheet:range(“d5:d5″):horizontalalignment:= 7
osheet:cells(5,4):columnWidth := 17.57

osheet:cells(5,5):value :=”Kredit”
osheet:cells(5,5):Font:Size:=12
oSheet:cells(5,5):Font:Bold:=.T.
osheet:cells(5,5):columnWidth := 17.57
oSheet:range(“e5:e5”):horizontalalignment:= 7

nrow:=6

ttdebet  := 0
ttkredit := 0
slaba    := 0
nProgres := 0

Do while .not. EOF()

oSheet:Cells(nRow,1):Value:=neraca->sno
//  oSheet:columns(1):horizontalalignment:=
oSheet:Cells(nRow,2):Value:=neraca->norek
oSheet:columns(2):horizontalalignment:= 7
oSheet:Cells(nRow,3):Value:=neraca->nmrek

oSheet:Cells(nRow,4):Value:=neraca->tdebet
if neraca->tdebet < 0
oSheet:Cells(nRow,4):numberformat := “(###.###.###.##0,00)”
else
oSheet:Cells(nRow,4):numberformat := “###.###.###.##0,00”
endif

oSheet:Cells(nRow,5):Value:=neraca->tkredit
if neraca->tkredit < 0
oSheet:Cells(nRow,5):numberformat := “(###.###.###.##0,00)”
else
oSheet:Cells(nRow,5):numberformat := ” ###.###.###.##0,00″
endif

TTDEBET := TTDEBET + TDEBET
TTKREDIT := TTKREDIT +TKREDIT
nrow++
nProgres++

&& Progresbar
SetWaitCursor( _HMG_MainHandle )
SetWaitCursor( GetControlHandle( ‘Progress_1’ , ‘wneraca’ ) )

aPos := GetCursorPos()
SetCursorPos( aPos[2] , aPos[1] )   // update cursor shape
nvalue :=reccount()
nJK    := ((nProgres/nValue)*100)

wneraca.Progress_1.Value := nJK

SetArrowCursor( _HMG_MainHandle )
SetArrowCursor( GetControlHandle( ‘Progress_1’ , ‘wneraca’ ) )

aPos := GetCursorPos()
SetCursorPos( aPos[2] , aPos[1] )   // update cursor shape

&& Akhir progresbar

select neraca
SKIP
ENDDO
nProgres := 0
nrow := nrow + 1
slaba := ttdebet-ttkredit

&& Mencari Laba & Rugi

oSheet:Cells(nRow,3):Value:= ” Laba / Rugi Tahun Berjalan ”
oSheet:Cells(nRow,5):Value:=slaba
oSheet:Cells(nRow,5):numberformat := ” ###.###.###.##0,00″

&& Mencari Total Laba & Rugi

nrow := nrow + 1
oSheet:Cells(nRow,4):Value:=ttdebet
oSheet:Cells(nRow,4):numberformat := ” ###.###.###.##0,00″
oSheet:Cells(nRow,5):Value:=ttKREDIT
oSheet:Cells(nRow,5):numberformat := ” ###.###.###.##0,00″

oExcel:visible := .T.
ferase(“J:\BACKUP\NERACA.XLS”)
oSheet:SaveAs(“J:\BACKUP\NERACA.XLS”)
Close NERACA

Return

2 Tanggapan

  1. wah Boz exampl program banyak sekali
    tapi contoh program buat buka cash drower untuk kasir belum dibuat ya boz
    lupa ya

    • Mas imam ,
      Untuk program cash drawer sebenarnya kagak ada yg istimewa mas , karena program clipper yg lama pun bisa jalan yg penting kable di cash drawer dihubungkan di printer jadi saat program mau mencetak ke printer otomatis cash drawernya akan membuka sendiri , untuk lebih jelasnya mas imam bisa ikut milis di CFI ( Clipper fan Indonesia )

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: