Senin, Mei 12, 2008

DBF to Excel

From Fox-Id

{ Vfp Code }
xlMedium=-4138
xlCenter=-4108
xlLeft=-4131
xlRight=-4152
xldiagonaldown= 5
xlbottom=-4107
xldiagonalup=6
xledgeleft=7
xlcontinuous=1
xlthin=2
xlautomatic=-4105
xledgetop=8
xledgebottom=9
xledgeright=10
xlinsidevertical=11
xlinsidehorizontal=12
xlautomatic=-4105
xlsolid=1
xlnone=-4142
xlLandscape=2
** Variable Jenis Kertas
xlPaperLegal=5
xLPaperA3=8
xlPaperA4=9
xlPaperLetter=1
** Jenis Cetakan
xlPortrait=1
xlLandscape=2

xlautomatic=-4105
xlDownThenOver=1
tmpsheet = Getobject('','excel.sheet')
&& Create Object excel
xlapp = tmpsheet.Application
&& Get Applikasi
xlapp.Visible = .F. && Tampilkan Excel di monitor
_workbook=xlapp.WorkBooks.Add()
xlsheet = xlapp.activesheet && Ambil Sheet yang active

With _workbook
.styles.Add("RETUR")
With .styles["RETUR"]
.Font.bold=.T.
.Interior.COlor=RGB(220,0,0)
Endwith
.styles.Add("VOID")
With .styles["VOID"]
.Font.bold=.T.
.Interior.COlor=RGB(0,220,0)
Endwith
ENDWITH

** Dibawah ini untuk ngeset opage
With xlsheet
With .PageSetup
.PrintTitleRows = "$1:$3" && Title Row ( Baris kebarapa yang akan di cetak di setiap halamn di contong ini baris 1 sampai dengan baris 7
.PrintTitleColumns = ""
&& Title Colums
.PrintArea = ""
&& Hapus Print Area
.LeftHeader = ""
&& Header Kiri
.CenterHeader = ""
&& Header tengah
.RightHeader =""
&& Header Kanan
.CenterFooter = "Page &P of &N"
&& Footer ( dicontoh ini Footer diisi dengan halaman )
.LeftFooter = "Printed Date : &D,&T"
&& Footer Tanggal di Kiri
.LeftMargin = tmpsheet.Application.InchesToPoints(0)
&& Margin kiri dalam Inch
.RightMargin = tmpsheet.Application.InchesToPoints(0)
&& Margin Kanan dalam Inch
.TopMargin = tmpsheet.Application.InchesToPoints(.5) && Margin Atas dalam Inch
.BottomMargin = tmpsheet.Application.InchesToPoints(.5)
&& Margin Bawah dalam Inch
.HeaderMargin = tmpsheet.Application.InchesToPoints(0.25)
&& Margin Header dalam Inch
.FooterMargin = tmpsheet.Application.InchesToPoints(0.25) && Margin Footer dalam Inch
**.Orientation = xlPortrait && Mau Landscape atau portrait ( 1 = Portrait, 2 = LandScape )
**.Papersize = xLPaperA3 && Jenis Kertas

.FirstPageNumber = xlautomatic
.Order = xlDownThenOver
.Zoom=65 && Bikin menjadi 65 %
Endwith
Endwith
xlsheet.Range("A1:P1").Merge && Merge Kolom 1 baris 1 sampai dengan Kolom 3 baris 1
xlsheet.Range("A1:P1").Value = "SALES REPORT "
xlsheet.Range("A1:P1").Font.bold=.T. && Buat Bold
xlsheet.Range("A1:P1").Font.Size=14 && Size 14
xlsheet.Range("A1:P1").horizontalalignment=xlCenter
&& Bikin ketengah

xlsheet.cells(3,2).Value="No Inv" && Isi cells B3
xlsheet.cells(3,3).Value="Hotel" && Isi Cells C3
xlsheet.cells(3,6).Value="Room" && Isi cells B3
xlsheet.cells(3,4).Value="Check In" && Isi ceclose lls B3
xlsheet.cells(3,5).Value="Check Out" && Isi Cells C3
xlsheet.cells(3,7).Value="Name Pax" && Isi Cells C3
xlsheet.cells(3,8).Value="Name agent" && Isi Cells C3
xlsheet.cells(3,9).Value="SGD" && Isi Cells C3
xlsheet.cells(3,10).Value="USD" && Isi Cells C3
xlsheet.cells(3,11).Value="Rp" && Isi Cells C3

xlsheet.cells(3,12).Value="COST" && Isi Cells C3
xlsheet.cells(3,13).Value="GP-SGD " && Isi Cells C3
xlsheet.cells(3,14).Value="GP-USD " && Isi Cells C3
xlsheet.cells(3,15).Value="GP-Rp " && Isi Cells C3

xlsheet.cells(3,16).Value="HotelBill" && Isi Cells C3
xlsheet.cells(3,17).Value="R/N" && Isi Cells C3
xlsheet.cells(3,18).Value="QTY ROOM" && Isi Cells C3
xlsheet.cells(3,19).Value="Kode Booking" && Isi Cells C3
xlsheet.cells(3,20).Value="Staff Agent" && Isi Cells C3
xlsheet.cells(3,21).Value="Collect Date" && Isi Cells C3
xlsheet.cells(3,22).Value="Remarks"
oRange = xlsheet.Range("A4:P4")
NCOL=16
oldroom=''
oldhotel=''
nRow=4
nUrut=0
Select (Thisform.baseadapter1.cursorlink.c_alias)
Go Top
Do While !Eof(Thisform.baseadapter1.cursorlink.c_alias)
nUrut=nUrut+1
With oRange
If icode='R'
oRange.Style="RETUR"
IF jenis="M"
.columns(1).value="MARKUP"
ENDIF
IF jenis="R"
.columns(1).value="RFND"
ENDIF
IF jenis="H"
.columns(1).value="HOTELSTMENT"
ENDIF
ENDIF
IF void
orange.style="VOID"
.columns(1).value="VOID"
ENDIF
.Columns(2).Value=no_invoice
If icode='R'
IF jenis="H"
.columns(6).value=oldroom
ELSE
.Columns(6).Value=ALLTRIM(roomdesc)
ENDIF
ELSE
.Columns(6).Value=ALLTRIM(roomdesc)
ENDIF
If icode='R'
IF jenis="H"
.Columns(3).Value=''
ELSE
.Columns(3).Value=nama_hotel
ENDIF
ELSE
.Columns(3).Value=nama_hotel
ENDIF
If ! Empty(check_in)
.Columns(4).Value=check_in
Endif
If ! Empty(check_out)
.Columns(5).Value=check_out
Endif
.Columns(7).Value=name_pax
.Columns(.Value=nama_agent
IF curr_type="SGD"
.Columns(9).Value=tagihan
ENDIF
IF curr_type="USD"
.Columns(10).Value=tagihan
ENDIF
IF UPPER(curr_type)="RP"
.Columns(11).Value=tagihan
ENDIF
.Columns(12).Value=Hdasar
** .Columns(12).Value=tagihan-Hdasar
IF curr_type="SGD"
.Columns(13).Value=tagihan-Hdasar
ENDIF
IF curr_type="USD"
.Columns(14).Value=tagihan-Hdasar
ENDIF
IF UPPER(curr_type)="RP"
.Columns(15).Value=tagihan-Hdasar
ENDIF
.Columns(16).Value=alice
.Columns(17).Value=r_n
.Columns(18).Value=qty
.Columns(19).Value=no_booking
.Columns(20).Value=aff_agent
If ! Empty(collect_date)
.Columns(21).Value=collect_date
Endif
.columns(22).value=Remark
Endwith

oldroom=roomdesc
oldhotel=nama_hotel
Skip
oRange = oRange.Offset(1,0)
nRow=nRow+1
Enddo

xlsheet.Range(xlsheet.cells(1,1),xlsheet.cells(nRow,NCOL-1)).EntireColumn.AutoFit && Bikin Autofit
kd8="=SUM( I4:I"+ALLTRIM(STR(nrow-1))+" )"
kd9="=SUM( J4:J"+ALLTRIM(STR(nrow-1))+" )"
kd10="=SUM( K4:K"+ALLTRIM(STR(nrow-1))+" )"
kd11="=SUM( L4:L"+ALLTRIM(STR(nrow-1))+" )"
kd12="=SUM( M4:M"+ALLTRIM(STR(nrow-1))+" )"
kd13="=SUM( N4:N"+ALLTRIM(STR(nrow-1))+" )"
xlsheet.cells[nrow,9].formula=kd8
xlsheet.cells[nrow,10].formula=kd9
xlsheet.cells[nrow,11].formula=kd10
xlsheet.cells[nrow,12].formula=kd11
xlsheet.cells[nrow,13].formula=kd12
xlsheet.cells[nrow,14].formula=kd13
WITH xlsheet.Range("B3:P"+ALLTRIM(STR(nrow-1)) )
.Borders[7].LineStyle = xlContinuous
.Borders[7].colorIndex= 23
.Borders[8].LineStyle = xlContinuous
.Borders[8].colorindex=23
.Borders[9].LineStyle = xlContinuous
.Borders[9].colorIndex=23
.Borders[10].LineStyle = xlContinuous
.Borders[10].colorIndex=23
.Borders[11].LineStyle = xlContinuous
.Borders[11].colorIndex=23

.Borders[12].LineStyle = xlContinuous
.Borders[12].colorIndex=23
ENDWITH
**xlsheet.PrintOut && Kalau mau langsung cetak
ok=.f.
Do While ! ok
Try
xlapp.activeworkbook.SaveAs("c:\SalesReport.xls")
&& Simpan Hasil excelnya
ok=.t.
Catch
If Messagebox('Kemungkinan anda membuka file SalesReport.xls,Tutup Dulu ,Ingin Melanjutkan ?',4)=7
ok=.t.
Endif

Endtry
Enddo

tmpsheet.Close && Close Applikasi Excel
Messagebox('Export Success di c:\Sales Report.xls')
xlapp.Visible=.T.
tmpsheet=Null
**xlapp=null
**xlsheet=null

{ End Code }

Tidak ada komentar: