Arsip: Konvert/copy Database ke Excel


by wiseguy1997 in Articles more 13 years ago 2661
Halo, para senior dan teman2 di komunitas Delphi Indonesia...
Perkenalkan aq Newbie mencoba share coding-ku yg kudapat di Internet dg sedikit modifikasi.
Tlah aq coba dg database ADO-MS Access2000/XP dan pake Delphi 6 berjalan sukses. Ni murni dg Delphi
n' tanpa install component apapun. Jg lupa tuliskan Excel2000 atu XP di uses-nya. Koment ato tanggapan di
situs ini aja biar tambah rame n pada pinter2 semua. Silahkan dicoba, smoga bermanfaat.
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;

Syntax Highlighted with https://pascal-id.org/syntax



Note: Thanks to Delphi-seniors for answer my questions ;)
Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com