LAMPIRAN Listing program Form Menu Private Sub a_Click() Unload Me lapkirimharian.Show End Sub Private Sub f_Click() Unload Me lapbarang.Show End Sub Private Sub q_Click() Unload Me frmdtbarang.Show End Sub Private Sub s_Click() Unload Me lapkirimbulanan.Show End Sub Private Sub w_Click() Unload Me frmkirim.Show End Sub Private Sub z_Click() End End Sub Form Data Barang Private Sub cmdbatal_Click() batal End Sub Private Sub cmddelete_Click() Data1.Recordset.Delete Data1.Recordset.MoveNext batal End Sub
Private Sub cmdedit_Click() Data1.Recordset.Edit Data1.Recordset!Kd_Brg = kode.Text Data1.Recordset!Nm_Brg = nama.Text Data1.Recordset!Jml_Brg = jml.Text Data1.Recordset!Berat_Brg = brt.Text Data1.Recordset!By_Kg = harga.Text Data1.Recordset!Tgl_masuk = tgl Data1.Recordset.Update Data1.Refresh batal End Sub Private Sub cmdend_Click() Unload Me frmmenu.Show End Sub
Private Sub cmdsimpan_Click() Data1.Recordset.AddNew Data1.Recordset!Kd_Brg = kode.Text Data1.Recordset!Nm_Brg = nama.Text Data1.Recordset!Jml_Brg = jml.Text Data1.Recordset!Berat_Brg = brt.Text Data1.Recordset!By_Kg = harga.Text Data1.Recordset!Tgl_masuk = tgl Data1.Recordset.Update batal End Sub Private Sub Form_Load() kode.MaxLength = 5 nama.MaxLength = 15 jml.MaxLength = 2 brt.MaxLength = 4 harga.MaxLength = 8 End Sub Private Sub batal() kode.Text = "" nama.Text = "" brt.Text = "" jml.Text = "" harga.Text = ""
tgl = "" End Sub Private Sub kode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Data1.Recordset.Index = "kdb" Data1.Recordset.Seek "=", kode.Text If Data1.Recordset.NoMatch Then MsgBox "Data Barang Belum Ada", vbOKOnly + vbExclamation, "KONFIRMASI" Else X = MsgBox("Data Sudah Ada, Anda Ingin Merubah Data Ini ?", vbYesNo, "Konfirmasi") If X = vbYes Then nama.Text = Data1.Recordset!Nm_Brg jml.Text = Data1.Recordset!Jml_Brg brt.Text = Data1.Recordset!Berat_Brg harga.Text = Data1.Recordset!By_Kg tgl = Data1.Recordset!Tgl_masuk End If End If End If End Sub Form Kirim Private Sub batal() kode.Text = "" nama.Text = "" brt.Text = "" jml.Text = "" harga.Text = "" faktur.Text = "" tujuan.Text = "" alamat.Text = "" tgl = "" biaya.Text = "" tglm = "" pengirim.Text = "" alt.Text = "" End Sub Private Sub cmdbatalkirim_Click() batal End Sub Private Sub cmdeditkirim_Click() Data2.Recordset.Edit Data2.Recordset!No_Fak = faktur.Text Data2.Recordset!Kd_Brg = kode.Text
Data2.Recordset!Nm_Tuj = tujuan.Text Data2.Recordset!almt_Tuj = alamat.Text Data2.Recordset!Tgl_Kir = tgl Data2.Recordset!By_Kir = biaya.Text Data2.Recordset!Nm_Pengirim = pengirim.Text Data2.Recordset!Almt_Pengirim = alt.Text Data2.Recordset.Update Data2.Refresh batal End Sub Private Sub cmdend_Click() Unload Me frmmenu.Show End Sub Private Sub cmdhapuskirim_Click() Data2.Recordset.Delete Data2.Recordset.MoveNext End Sub Private Sub cmdhitung_Click() biaya.Text = Val(brt.Text) * Val(harga.Text) End Sub Private Sub cmdsimpankirim_Click() Data2.Recordset.AddNew Data2.Recordset!No_Fak = faktur.Text Data2.Recordset!Kd_Brg = kode.Text Data2.Recordset!Nm_Tuj = tujuan.Text Data2.Recordset!almt_Tuj = alamat.Text Data2.Recordset!Tgl_Kir = tgl Data2.Recordset!By_Kir = biaya.Text Data2.Recordset!Nm_Pengirim = pengirim.Text Data2.Recordset!Almt_Pengirim = alt.Text Data2.Recordset.Update batal End Sub Private Sub kode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Data1.Recordset.Index = "kdb" Data1.Recordset.Seek "=", kode.Text If Data1.Recordset.NoMatch Then MsgBox "Data Barang Belum Ada", vbOKOnly + vbExclamation, "KONFIRMASI" Else
MsgBox "Data Barang Sudah Ada", vbOKOnly + vbExclamation, "KONFIRMASI" nama.Text = Data1.Recordset!Nm_Brg jml.Text = Data1.Recordset!Jml_Brg brt.Text = Data1.Recordset!Berat_Brg harga.Text = Data1.Recordset!By_Kg tglm = Data1.Recordset!Tgl_masuk End If End If End Sub Private Sub faktur_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Data2.Recordset.Index = "NF" Data2.Recordset.Seek "=", faktur.Text If Data2.Recordset.NoMatch Then MsgBox "Data Kirim Belum Ada", vbOKOnly + vbExclamation, "KONFIRMASI" Else MsgBox "Data Kirim Sudah Ada", vbOKOnly + vbExclamation, "KONFIRMASI" tujuan.Text = Data2.Recordset!Nm_Tuj alamat.Text = Data2.Recordset!almt_Tuj tgl = Data2.Recordset!Tgl_Kir biaya.Text = Data2.Recordset!By_Kir pengirim.Text = Data2.Recordset!Nm_Pengirim alt.Text = Data2.Recordset!Almt_Pengirim End If End If End Sub Form Laporan Kirim Harian Private Sub cmdend_Click() Unload Me frmmenu.Show End Sub Private Sub CboAkhir_Click() If Cboawal = "" Then MsgBox "Tanggal awal kosong", , "Informasi" Cboawal.SetFocus Exit Sub End If CrystalReport1.SelectionFormula = "{Kirim.Tgl_Kir} in date (" & Cboawal.Text & ") to date (" & CboAkhir.Text & ")" CrystalReport1.ReportFileName = "C:\Program Ami\Laporan\lapkirimhari.rpt" CrystalReport1.WindowState = crptMaximized
CrystalReport1.RetrieveDataFiles CrystalReport1.Action = 1 End Sub Sub Form_Load() Data1.RecordSource = "Select Distinct Tgl_kir from Kirim Order By 1" Data1.Refresh Do Until Data1.Recordset.EOF Cboawal.AddItem Format(Data1.Recordset!Tgl_Kir, "YYYY ,MM, DD") CboAkhir.AddItem Format(Data1.Recordset!Tgl_Kir, "YYYY ,MM, DD") Data1.Recordset.MoveNext Loop End Sub Form Laporan Kirim Bulanan Private Sub cmdend_Click() Unload Me frmmenu.Show End Sub Private Sub CboAkhir_Click() If Cboawal = "" Then MsgBox "Tanggal awal kosong", , "Informasi" Cboawal.SetFocus Exit Sub End If CrystalReport1.SelectionFormula = "{Kirim.Tgl_Kir} in date (" & Cboawal.Text & ") to date (" & CboAkhir.Text & ")" CrystalReport1.ReportFileName = "C:\Program Ami\Laporan\lapkirimbulan.rpt" CrystalReport1.WindowState = crptMaximized CrystalReport1.RetrieveDataFiles CrystalReport1.Action = 1 End Sub Sub Form_Load() Data1.RecordSource = "Select Distinct Tgl_kir from Kirim Order By 1" Data1.Refresh Do Until Data1.Recordset.EOF Cboawal.AddItem Format(Data1.Recordset!Tgl_Kir, "YYYY ,MM, DD") CboAkhir.AddItem Format(Data1.Recordset!Tgl_Kir, "YYYY ,MM, DD") Data1.Recordset.MoveNext Loop End Sub
Form Laporan Barang Harian Private Sub cmdend_Click() Unload Me frmmenu.Show End Sub Private Sub CboAkhir_Click() If Cboawal = "" Then MsgBox "Tanggal awal kosong", , "Informasi" Cboawal.SetFocus Exit Sub End If CrystalReport1.SelectionFormula = "{Barang.Tgl_masuk} in date (" & Cboawal.Text & ") to date (" & CboAkhir.Text & ")" CrystalReport1.ReportFileName = "C:\Program Ami\bulan.rpt" CrystalReport1.WindowState = crptMaximized CrystalReport1.RetrieveDataFiles CrystalReport1.Action = 1 End Sub Sub Form_Load() Data1.RecordSource = "Select Distinct Tgl_masuk from Barang Order By 1" Data1.Refresh Do Until Data1.Recordset.EOF Cboawal.AddItem Format(Data1.Recordset!Tgl_masuk, "YYYY ,MM, DD") CboAkhir.AddItem Format(Data1.Recordset!Tgl_masuk, "YYYY ,MM, DD") Data1.Recordset.MoveNext Loop End
Tampilan Program Menu Utama
Form Data Barang
Form Data Kirim Barang
Form Laporan Data Kirim Harian
Form Laporan Data Kirim Bulanan
PT. LAJU MERAPI LAPORAN DATA KIRIM PER HARI No_Fak
Kd_Brg
Nm_Tuj
Tgl_Kir
By_Kir
Almt_Tuj
Nm_Pengirim
Almt_Pengirim
F001
P001
Aditya
11/ 02/2006
Rp30000
Jl.Gading
Amy
Jl.Raya
F002
P002
Astrit
11/ 02/ 2006
Rp60000
No.6
No.6
Pekalongan
Tegal
Jl.Banyu Manis
Ary No.3
Adiwerna
Jl.Praja No.1 Pemalang
Slawi F003
F004
T003
V004
Fathony
Ayu
11/ 02/ 2006
11/ 02/ 2006
Rp150000
Rp140000
Jl.Banjar
Ida
Jl.Raya Ujung Rusi
No.1
No.23
Semarang
Slawi
Jl.Raffles
Rina
No.6
Jl.Pariyang No.4 Brebes
Kendal F005
T005
Myla
11/ 02/ 2006
Rp80000
Jl.Plaju No.1 Cirebon
TOTAL
Titie
Jl.Jackha No.1 Adw. Legal
Rp 460000 Tegal 11 Februari 2006 ( ………………………) Bag.Adm
PT. LAJU MERAPI LAPORAN DATA KIRIM PER BULAN No_Fak
Kd_Brg
Nm_Tuj
Tgl_Kir
By_Kir
Almt_Tuj
Nm_Pengirim
Almt_Pengirim
F001
P001
Sardy
1/ 02/2006
Rp30000
Jl.Jagang
Amy
Jl.Raya
F002
P002
Astrit
11/ 02/ 2006
Rp60000
No.79
No.6
Semarang
Tegal
Jl.Banyu Manis
Ary No.3
Adiwerna
Jl.Praja No.1 Pemalang
Slawi F003
T003
Heru
12/ 02/ 2006
Rp150000
Jl.Banjar
Ida
No.1 Cirebon
Jl.Raya Ujung Rusi No.23 Slawi
F004
V004
Dian
21/ 02/ 2006
Rp140000
Jl.Raffles
Rina
No.6
Jl.Pariyang No.4 Brebes
Kendal F005
T005
Mya
28/ 02/ 2006
Rp80000
Jl.Plaju No.1 Cirebon
TOTAL
Titie
Jl.Jackha No.1 Adw. Tegal
Rp 460000 Tegal 11 Februari 2006 ( ………………………) Bag.Adm
