Lat 8 Inputan Database MS Acces 2003 + Cetak Laporan Ke Exce

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, Grids, DBGrids, StdCtrls, Comobj;
  //Comobj digunakan untuk memanggil modul agar bisa nyetak ke excel
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Edit4: TEdit;
    Button1: TButton;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    ADOQuery2: TADOQuery;
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure Edit4Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
    XlApp, XlBook, XlSheet, XlSheets, Range,chat : Variant; // Excel 97
    WApp, Word : Variant; // Word 97
  public
    { Public declarations }
    procedure bersih;
    procedure segar;
    procedure konek;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.bersih;
begin
  Edit1.Clear;
  Edit2.Clear;
  Edit3.Clear;
  Edit4.Clear;
end;

Procedure TForm1.konek;
Var a:String;
Begin
  //Pemanggilan Database Secara Portable tanpa terikat directory
  //Maksudnya tanpa perlu konekkan lagi pada ADOConnection1
  GetDir(0,a);
  With ADOConnection1 Do Begin
    ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='+a+'\STMIK.mdb;Extended Properties="";Persist Security Info=False;Jet OLEDB:System database="";Jet OLEDB:Registry Path="";Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1';
    LoginPrompt:=False;
    Connected:=true;
    ConnectionTimeout:=15;
    ConnectOptions:=coConnectUnspecified;
    CursorLocation:=clUseClient;
    Mode:=cmShareDenyNone;
  End;
  ADOQuery1.Active;
End;

procedure TForm1.segar;
begin
  AdoQuery1.SQL.Clear;
  AdoQuery1.sql.Text:='SELECT * FROM mhs ORDER BY Nama';
  AdoQuery1.Open;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit4.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Edit1.Text='' then begin
    ShowMessage('Nim Kosong, Silahkan Isi dahulu');
    Edit1.SetFocus;
  end
  else if Length(Edit1.Text)<13 then begin
    ShowMessage('Nim Belum Lengkap, Silahkan Isi dahulu');
    Edit1.SetFocus;
  end
  else Begin
    AdoQuery2.SQL.Clear;
    AdoQuery2.SQL.Text:='Insert Into mhs(NIm,Nama,Alamat) Values('+
    QuotedStr(Edit1.Text)+','+QuotedStr(Edit2.Text)+','+QuotedStr(Edit3.Text)+')';
    AdoQuery2.ExecSQL;

    Bersih;
    segar;
  End;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if Edit1.Text='' then begin
    ShowMessage('Nim Kosong, Silahkan Isi dahulu');
    Edit1.SetFocus;
  end
  else if Length(Edit1.Text)<13 then begin
    ShowMessage('Nim Belum Lengkap, Silahkan Isi dahulu');
    Edit1.SetFocus;
  end
  else Begin
    AdoQuery2.SQL.Clear;
    AdoQuery2.SQL.Text:='UPDATE mhs SET Nama='+
    QuotedStr(Edit2.Text)+', Alamat='+QuotedStr(Edit3.Text)+' WHERE NIm='+
    QuotedStr(Edit1.Text)+'';
    AdoQuery2.ExecSQL;

    Bersih;
    segar;
  End;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if Edit1.Text='' then begin
    ShowMessage('Nim Kosong, Silahkan Isi dahulu');
    Edit1.SetFocus;
  end
  else if Length(Edit1.Text)<13 then begin
    ShowMessage('Nim Belum Lengkap, Silahkan Isi dahulu');
    Edit1.SetFocus;
  end
  else Begin
    AdoQuery2.SQL.Clear;
    AdoQuery2.SQL.Text:='DELETE FROM mhs WHERE NIm='+QuotedStr(Edit1.Text)+'';
    AdoQuery2.ExecSQL;

    Bersih;
    segar;
  End;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  bersih;
  Segar;
end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
  if Not AdoQuery1.Eof  then begin
    Edit1.Text:=AdoQuery1.FieldValues['NIm'];
    Edit2.Text:=AdoQuery1.FieldValues['Nama'];
    Edit3.Text:=AdoQuery1.FieldValues['Alamat'];
  end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if Edit1.Text <> '' then Begin
  AdoQuery1.SQL.Clear;
  AdoQuery1.sql.Text:='SELECT * FROM mhs WHERE NIm='+QuotedStr(Edit1.Text);
  AdoQuery1.Open;

  if Not AdoQuery1.Eof  then begin
    Edit2.Text:=AdoQuery1.FieldValues['Nama'];
    Edit3.Text:=AdoQuery1.FieldValues['Alamat'];
  end;
End;

end;

procedure TForm1.Edit4Change(Sender: TObject);
begin
if Edit4.Text='' then begin
  //Edit4.SetFocus;
end;

if Edit4.Text<>'' then Begin

  AdoQuery1.SQL.Clear;
  ADOQuery1.SQL.Add('SELECT * FROM mhs WHERE Nama like "'+Edit4.Text+'%" Order By Nama');
  AdoQuery1.Open;

  if Not AdoQuery1.Eof  then begin
    Edit2.Text:=AdoQuery1.FieldValues['Nama'];
    Edit3.Text:=AdoQuery1.FieldValues['Alamat'];
  end;

end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  konek; //Procedure Konek dipanggil
  bersih; //Procedure Bersih
  segar; //Procedure Segar
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button6Click(Sender: TObject);
var i,x:integer;
    Sfile:string;
begin
// buka excel
XlApp := CreateOleObject('Excel.Application');
// tambahkan workbook
XlBook := XlApp.WorkBooks.Add;
// tambahkan worksheet
XlSheet := XlBook.worksheets.add;
//untuk mengubah lebar kolom bisa dilakukan dengan cara dibawah ini
XlSheet.Cells[1,1].ColumnWidth := 8;
XlSheet.Cells[1,2].ColumnWidth := 9;
XlSheet.Cells[1,3].ColumnWidth := 11;
XlSheet.Cells[1,4].ColumnWidth := 10;
XlSheet.Cells[1,5].ColumnWidth := 10;
XlSheet.Cells[1,6].ColumnWidth := 14;
XlSheet.Cells[1,7].ColumnWidth := 19;
XlSheet.Cells[1,8].ColumnWidth := 16;
XlSheet.Cells[1,9].ColumnWidth := 16;
XlSheet.Cells[1,10].ColumnWidth := 18;
//cetak judul header menual
XlSheet.Cells[1,1].Value:='LAPORAN TRANSAKSI KELUAR';
//cetak header field dari dbgrid
for i:=0 to dbgrid1.FieldCount-1 do
begin
XlSheet.cells[3,i+1].value:=dbgrid1.columns[i].Title.Caption;
end;
// transfer data ke excel
ADOQuery1.First;
x:=1;
while not ADOQuery1.Eof do
begin
for i:=0 to dbgrid1.FieldCount-1 do
begin
XlSheet.cells[3+x,i+1].value:=dbgrid1.Fields[i].Text;
end;
ADOQuery1.Next;
inc(x);
end;

//menampilkan aplikasi //XlApp.visible:=true;

//script dibawah ini untuk dialog disimpan atau ditampilkan

  if MessageDlg('Apakah hasil export ditampilkan..?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    MessageDlg('Hasil Ditampilkan', mtInformation,
      [mbOk], 0);
       XlApp.visible:=true;
  end
  else
  //simpan ke file
  begin
    Sfile:= InputBox('Nama File', 'hasil export', 'd:\hasil.xls');
    XlApp.ActiveWorkbook.SaveAs(sfile);
    XlApp.visible:=true;
  end
end;

end.