Arsip: Konvert/copy Database ke Excel

Uses ....., Excel2000;





Function TForm1.ExportToExcel(oDataSet : TDataSet; const sFile : String): Boolean;

var

iCol,iRow : Integer;

oExcel  : TExcelApplication;

oWorkbook : TExcelWorkbook;

oSheet  : TExcelWorksheet;

begin

begin

oDataSet.Close;

iCol   := 0;

iRow   := 1;  //untuk memberi tempat bagi nama field

     result := True;

oExcel  := TExcelApplication.Create(Application);

oWorkbook := TExcelWorkbook.Create(Application);

oSheet  := TExcelWorksheet.Create(Application);

try

oExcel.Visible[0] := False;

oExcel.Connect;

except

result      := False;

MessageDlg('Microsoft Excel belum terinstal pada komputer ini', mtError, [mbOk], 0);

exit;

end;

oExcel.Visible[0] := True;

oExcel.Caption  := 'Aplikasi Toko'; //Nama aplikasi Anda

     oExcel.Workbooks.Add(Null,0);

oWorkbook.ConnectTo(oExcel.Workbooks[1]);

oSheet.ConnectTo(oWorkbook.Worksheets[1] as _Worksheet);//[1] menunjukkan sheet ke-1

     oDataSet.Active:=True;

oDataSet.Open;

while NOT oDataSet.Eof do begin

Inc(iRow);

//Meletakkan tempat bagi masing-masing Nama Field

         oSheet.Range['A1','A1'].Value:='Kode Barang';

oSheet.Range['B1','B1'].Value:='Nama Barang';

oSheet.Range['C1','C1'].Value:='Jumlah Satuan Beli';

oSheet.Range['D1','D1'].Value:='Keterangan Satuan Beli';

oSheet.Range['E1','E1'].Value:='Harga Satuan Beli';

oSheet.Range['F1','F1'].Value:='Margin Satuan Beli';

oSheet.Range['G1','G1'].Value:='Harga Satuan Jual';

oSheet.Range['H1','H1'].Value:='Koefisien A';

oSheet.Range['I1','I1'].Value:='Jumlah Sub Satuan Beli';

oSheet.Range['J1','J1'].Value:='Keterangan Sub Satuan Beli';

oSheet.Range['K1','K1'].Value:='Harga Sub Satuan Beli';

oSheet.Range['L1','L1'].Value:='Margin Sub Satuan Beli';

oSheet.Range['M1','M1'].Value:='Harga Sub Satuan Jual';

oSheet.Range['N1','N1'].Value:='Koefisien B';

oSheet.Range['O1','O1'].Value:='Jumlah Unit Beli';

oSheet.Range['P1','P1'].Value:='Keterangan Unit Beli';

oSheet.Range['Q1','Q1'].Value:='Harga Unit Beli';

oSheet.Range['R1','R1'].Value:='Margin Unit Beli';

oSheet.Range['S1','S1'].Value:='Harga Unit Jual';

oSheet.Range['T1','T1'].Value:='Tanggal';

for iCol:=0 to oDataSet.FieldCount-1 do begin

try

oDataSet.Fields[iCol].AsString;

except

MessageDlg('Tidak ada kolom yang bertipe string', mtError, [mbOk], 0);

exit;

end;

oSheet.Cells.Item[iRow,iCol+1] := oDataSet.Fields[iCol].Value;

if oDataSet.FieldDefs[iCol].DataType IN [ftString] then

oSheet.Cells.Item[iRow,iCol+1] := oDataSet.Fields[iCol].Value;

if oDataSet.FieldDefs[iCol].DataType IN [ftInteger,ftSmallint,ftWord] then

oSheet.Cells.Item[iRow,iCol+1] := IntToStr(oDataSet.Fields[iCol].Value);

if oDataSet.FieldDefs[iCol].DataType IN [ftDateTime] then

oSheet.Cells.Item[iRow,iCol+1] := DateTimeToStr(oDataSet.Fields[iCol].Value);

if oDataSet.FieldDefs[iCol].DataType IN [ftFloat,ftCurrency] then

oSheet.Cells.Item[iRow,iCol+1] := CurrToStr(oDataSet.Fields[iCol].Value);

end;

oDataSet.Next;

end;

//membuat nama di worksheet.

     oSheet.Name := 'Ini dari Tabel Daftar Barang';

//mengubah format font di semua kolom.

     oSheet.Columns.Font.Color   := clBlack;

oSheet.Columns.Font.FontStyle := fsBold;

oSheet.Columns.Font.Size    := 10;

//Auto fit all columns.

     oSheet.Columns.AutoFit;

DeleteFile(sFile);

Sleep(2000);

oSheet.SaveAs(sFile);  

oSheet.Disconnect;

oSheet.Free;

oWorkbook.Disconnect;

oWorkbook.Free;

oExcel.Quit;

oExcel.Disconnect;

oExcel.Free;

end;

End;



procedure TForm1.ButtExcelDafBarOnClick(Sender: TObject);

begin

//Membuat file Excel dg nama 'Tabel Daftar Barang' di direktori C;\\ 

  ExportToExcel(ADOTable1,'C:\\Tabel Daftar Barang.XLS');

end;