Copyright by : ipi-leppindo jambi all reserved 2014 (japikinfo.com)

1

Copyright © by : ipi-leppindo jambi all reserved 2014  (japikinfo.com)

FORM DATA BARANG Dim Db As Database Dim RsBarang As Recordset Sub Koneksi() 'Koneksi Database Set Db = OpenDatabase("Tentukan Lokasi Database\Barang.mdb") Set RsBarang = Db.OpenRecordset("Table_Stok") End Sub Private Sub cmdbatal_Click() Call mati Call Bersih End Sub Private Sub cmdedit_Click() If txtkode.Text = Empty Or txtnabar.Text = Empty Or txtharga.Text = Empty Or txtstok.Text = Empty Then MsgBox "Tidak Ada data yang akan diperbaiki", vbExclamation, "Error" txtcari.SetFocus Else tanya = MsgBox("Benar Kode Barang " & txtkode.Text & ", Ini Akan Diperbaiki ?", vbQuestion + vbYesNo, "Warning") If tanya = vbYes Then RsBarang.Edit RsBarang!Kode_Barang = txtkode.Text RsBarang!Nama_Barang = txtnabar.Text RsBarang!Harga = txtharga.Text RsBarang!Stok = txtstok.Text RsBarang.Update Data_Barang.Refresh GridBarang.Refresh MsgBox "Data Berhasil Dirubah", vbInformation, "Pesan" Call Bersih Else MsgBox "Batal Edit Data", vbExclamation, "Warning" Call Bersih End If End If End Sub

2


Private Sub cmdhapus_Click() If txtkode.Text = Empty Or txtnabar.Text = Empty Or txtharga.Text = Empty Or txtstok.Text = Empty Then MsgBox "Tidak Ada data yang akan dihapus", vbExclamation, "Error" txtcari.SetFocus Else tanya = MsgBox("Benar Data Kode Barang " & txtkode.Text & ", Ini Akan DiHapus ?", vbQuestion + vbYesNo, "Pesan") If tanya = vbYes Then Call Koneksi RsBarang.Index = "idx_kode" RsBarang.Seek "=", txtkode.Text RsBarang.Delete MsgBox "Berhasil Dihapus", vbInformation, "Pesan" Data_Barang.Refresh GridBarang.Refresh Call Bersih Else MsgBox "Batal Penghapusan Data", vbExclamation, "Error" Call Bersih End If End If End Sub Private Sub cmdkeluar_Click() Unload Me End Sub Private Sub cmdsimpan_Click() If txtkode.Text = "" Or txtnabar.Text = "" Or txtharga.Text = "" Or txtstok.Text = "" Then MsgBox "Pengisian Belum Lengkap", vbCritical, "Error" Else RsBarang.Index = "idx_kode" RsBarang.Seek "=", txtkode.Text If RsBarang.NoMatch Then RsBarang.AddNew 'Sesuaikan Nama Field di Database dan Di Form RsBarang!Kode_Barang = txtkode.Text RsBarang!Nama_Barang = txtnabar.Text RsBarang!Harga = txtharga.Text RsBarang!Stok = txtstok.Text

3


RsBarang.Update MsgBox "Berhasil disimpan", vbInformation, "Pesan" Data_Barang.Refresh GridBarang.Refresh Call Bersih Else MsgBox "Kode Barang Sudah Ada", vbExclamation, "Pesan" txtkode.Text = "" txtkode.SetFocus End If End If End Sub Private Sub cmdtambah_Click() Call Hidup End Sub Sub Hidup() frameinput.Enabled = True cmdsimpan.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True txtkode.SetFocus framecari.Enabled = True End Sub Sub mati() frameinput.Enabled = False cmdsimpan.Enabled = False cmdhapus.Enabled = False cmdedit.Enabled = False framecari.Enabled = False End Sub Private Sub Form_Load() Call Koneksi Call mati End Sub Sub Bersih() txtkode.Text = "" txtnabar.Text = "" txtharga.Text = "" txtstok.Text = "" txtcari.Text = "" End Sub Private Sub txtcari_Change() RsBarang.Index = "idx_kode"

4


RsBarang.Seek "=", txtcari.Text If RsBarang.NoMatch Then txtkode.Text = Empty txtnabar.Text = Empty txtharga.Text = Empty txtstok.Text = Empty Exit Sub Else txtkode.Text = RsBarang!Kode_Barang txtnabar.Text = RsBarang!Nama_Barang txtharga.Text = RsBarang!Harga txtstok.Text = RsBarang!Stok MsgBox "Kode Ditemukan", vbInformation, "warning" End If End Sub Private Sub txtnabar_Change() 'Awal Kata Capital txtnabar.Text = StrConv(txtnabar, vbProperCase) SendKeys "{end}" End Sub

5


Form Pemasok Barang Dim Db As Database Dim RsPemasok As Recordset Sub Koneksi() Set Db = OpenDatabase("Tentukan Lokasi Database\Barang.mdb") Set RsPemasok = Db.OpenRecordset("Tabel_Pemasok") End Sub Private Sub cmdbatal_Click() Call Bersih Call mati End Sub Private Sub cmdedit_Click() If txtidpemasok.Text = Empty Or txtnmpemasok.Text = Empty Or txtalamat.Text = Empty Or _ txtkota.Text = Empty Or txtpropinsi.Text = Empty Or txttlp.Text = Empty Or txtfax.Text = Empty Then MsgBox "Tidak Ada data yang akan diperbaiki", vbExclamation, "Error" txtcari.SetFocus Else tanya = MsgBox("Benar ID Pemasok " & txtidpemasok.Text & ", Ini Akan Diperbaiki ?", vbQuestion + vbYesNo, "Warning") If tanya = vbYes Then RsPemasok.Edit RsPemasok!ID_Pemasok = txtidpemasok RsPemasok!Nama_pemasok = txtnmpemasok RsPemasok!Alamat = txtalamat RsPemasok!Kota = txtkota.Text RsPemasok!Provinsi = txtpropinsi.Text RsPemasok!No_Telp = txttlp.Text RsPemasok!Fax = txtfax.Text RsPemasok.Update Data_Pemasok.Refresh GridPemasok.Refresh MsgBox "Data Berhasil Dirubah", vbInformation, "Pesan" Call Bersih Else MsgBox "Batal Edit Data", vbExclamation, "Warning" Call Bersih End If End If End Sub

6


Private Sub cmdhapus_Click() If txtidpemasok.Text = Empty Or txtnmpemasok.Text = Empty Or txtalamat.Text = Empty Or _ txtkota.Text = Empty Or txtpropinsi.Text = Empty Or txttlp.Text = Empty Or txtfax.Text = Empty Then MsgBox "Tidak Ada data yang akan dihapus", vbExclamation, "Error" txtcari.SetFocus Else tanya = MsgBox("Benar Data ID Pemasok " & txtidpemasok.Text & ", Ini Akan DiHapus ?", vbQuestion + vbYesNo, "pesan") If tanya = vbYes Then Call Koneksi RsPemasok.Index = "idx_pemasok" RsPemasok.Seek "=", txtidpemasok.Text RsPemasok.Delete MsgBox "Berhasil Dihapus", vbInformation, "Pesan" Data_Pemasok.Refresh GridPemasok.Refresh Call Bersih Else MsgBox "Batal Penghapusan Data", vbExclamation, "Error" Call Bersih End If End If End Sub Private Sub cmdkeluar_Click() Unload Me End Sub Private Sub cmdsimpan_Click() RsPemasok.Index = "idx_pemasok" RsPemasok.Seek "=", txtidpemasok.Text If RsPemasok.NoMatch Then RsPemasok.AddNew 'Sesuaikan Nama Field di Database dan Di Form RsPemasok!ID_Pemasok = txtidpemasok RsPemasok!Nama_pemasok = txtnmpemasok RsPemasok!Alamat = txtalamat RsPemasok!Kota = txtkota.Text RsPemasok!Provinsi = txtpropinsi.Text RsPemasok!No_Telp = txttlp.Text RsPemasok!Fax = txtfax.Text RsPemasok.Update MsgBox "Berhasil disimpan", vbInformation, "Pesan" Data_Pemasok.Refresh

7


GridPemasok.Refresh Call Bersih Else MsgBox "ID Pemasok Sudah Ada", vbExclamation, "Pesan" End If End Sub Sub Bersih() txtidpemasok.Text = "" txtnmpemasok.Text = "" txtalamat.Text = "" txtkota.Text = "" txtpropinsi.Text = "" txttlp.Text = "" txtfax.Text = "" End Sub Private Sub cmdtambah_Click() Call Hidup End Sub Private Sub Form_Load() Call Koneksi Call mati End Sub Sub mati() cmdsimpan.Enabled = False cmdhapus.Enabled = False cmdedit.Enabled = False cmdhapus.Enabled = False frminput.Enabled = False Frame2.Enabled = False End Sub Sub Hidup() cmdsimpan.Enabled = True cmdhapus.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True Frame2.Enabled = True frminput.Enabled = True txtidpemasok.SetFocus End Sub Private Sub txtcari_Change() RsPemasok.Index = "idx_pemasok" RsPemasok.Seek "=", txtcari.Text If RsPemasok.NoMatch Then txtidpemasok.Text = Empty txtnmpemasok.Text = Empty txtalamat.Text = Empty txtkota.Text = Empty

8


txtpropinsi.Text = Empty txttlp.Text = Empty txtfax.Text = Empty Exit Sub Else txtidpemasok.Text = RsPemasok!ID_Pemasok txtnmpemasok.Text = RsPemasok!Nama_pemasok txtalamat.Text = RsPemasok!Alamat txtkota.Text = RsPemasok!Kota txtpropinsi.Text = RsPemasok!Provinsi txttlp.Text = RsPemasok!No_Telp txtfax.Text = RsPemasok!Fax End If End Sub

9


FORM DATA PELANGGAN Dim Db As Database Dim RsPelanggan As Recordset Sub Koneksi() Set Db = OpenDatabase("Tentukan Lokasi Database\Barang.mdb") Set RsPelanggan = Db.OpenRecordset("Tabel_Pelanggan") End Sub

Private Sub cmdbatal_Click() Call Bersih Call mati End Sub Private Sub cmdedit_Click() If txtid_pelanggan.Text = Empty Or txtnama_pelanggan.Text = Empty Or txtalamat.Text = Empty Or_ txtno_tlp.Text = Empty Or txtfax.Text = Empty Then MsgBox "Tidak Ada data yang akan diperbaiki", vbExclamation, "Error" txtcari.SetFocus Else tanya = MsgBox("Benar ID Pelanggan " & txtid_pelanggan.Text & ", Ini Akan Diperbaiki ?", vbQuestion + vbYesNo, "Warning") If tanya = vbYes Then RsPelanggan.Edit RsPelanggan!ID_Pelanggan = txtid_pelanggan.Text RsPelanggan!Nama_Pelanggan = txtnama_pelanggan.Text RsPelanggan!Alamat = txtalamat.Text RsPelanggan!No_Telp = txtno_tlp.Text RsPelanggan!Fax = txtfax.Text RsPelanggan.Update Data_Pelangga.Refresh GridPelanggan.Refresh MsgBox "Data Berhasil Dirubah", vbInformation, "Pesan" Call Bersih Else MsgBox "Batal Edit Data", vbExclamation, "Warning" Call Bersih End If End If

10


End Sub Private Sub cmdhapus_Click() If txtidpemasok.Text = Empty Or txtnmpemasok.Text = Empty Or txtalamat.Text = Empty Or _ txttlp.Text = Empty Or txtfax.Text = Empty Then MsgBox "Tidak Ada data yang akan dihapus", vbExclamation, "Error" txtcari.SetFocus Else tanya = MsgBox("Benar Data ID Pelanggan " & txtid_pelanggan.Text & ", Ini Akan DiHapus ?", vbQuestion + vbYesNo, "pesan") If tanya = vbYes Then Call Koneksi RsPelanggan.Index = "idx_pelanggan" RsPelanggan.Seek "=", txtid_pelanggan.Text RsPelanggan.Delete MsgBox "Berhasil Dihapus", vbInformation, "Pesan" Data_Pelangga.Refresh GridPelanggan.Refresh Call Bersih Else MsgBox "Batal Penghapusan Data", vbExclamation, "Error" Call Bersih End If End If End Sub Private Sub cmdkeluar_Click() Unload Me End Sub Private Sub cmdsimpan_Click() RsPelanggan.Index = "idx_pelanggan" RsPelanggan.Seek "=", txtid_pelanggan.Text If RsPelanggan.NoMatch Then RsPelanggan.AddNew 'Sesuaikan Nama Field di Database dan Di Form RsPelanggan!ID_Pelanggan = txtid_pelanggan.Text RsPelanggan!Nama_Pelanggan = txtnama_pelanggan.Text RsPelanggan!Alamat = txtalamat.Text RsPelanggan!No_Telp = txtno_tlp.Text RsPelanggan!Fax = txtfax.Text RsPelanggan.Update MsgBox "Berhasil disimpan", vbInformation, "Pesan" Data_Pelangga.Refresh GridPelanggan.Refresh Call Bersih Else

11


MsgBox "ID Pelanggan Sudah Ada", vbExclamation, "Pesan" End If End Sub Sub Bersih() txtid_pelanggan.Text = "" txtnama_pelanggan.Text = "" txtalamat.Text = "" txtno_tlp.Text = "" txtfax.Text = "" txtcari.Text = "" End Sub Private Sub cmdtambah_Click() Call Hidup End Sub Private Sub Form_Load() Call Koneksi Call mati End Sub Sub mati() cmdsimpan.Enabled = False cmdhapus.Enabled = False cmdedit.Enabled = False cmdhapus.Enabled = False frameinput.Enabled = False framecari.Enabled = False End Sub Sub Hidup() cmdsimpan.Enabled = True cmdhapus.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True framecari.Enabled = True frameinput.Enabled = True txtid_pelanggan.SetFocus End Sub Private Sub txtcari_Change() RsPelanggan.Index = "idx_pelanggan" RsPelanggan.Seek "=", txtcari.Text If RsPelanggan.NoMatch Then txtid_pelanggan.Text = Empty txtnama_pelanggan.Text = Empty txtalamat.Text = Empty

12


txtno_tlp.Text = Empty txtfax.Text = Empty Exit Sub Else txtid_pelanggan.Text = RsPelanggan!ID_Pelanggan txtnama_pelanggan.Text = RsPelanggan!Nama_Pelanggan txtalamat.Text = RsPelanggan!Alamat txtno_tlp.Text = RsPelanggan!No_Telp txtfax.Text = RsPelanggan!Fax MsgBox "ID Pelanggan Ditemukan", vbInformation, "Perhatian" End If End Sub

FORM DATA PEMBELIAN

Dim Db As Database Dim RsPemasok As Recordset Dim RsPembelian As Recordset Dim RsBarang As Recordset Sub Koneksi() Set Db = OpenDatabase("Tentukan Lokasi Database\Barang.mdb") Set RsPemasok = Db.OpenRecordset("Tabel_Pemasok") Set RsPembelian = Db.OpenRecordset("Tabel_Pembelian") Set RsBarang = Db.OpenRecordset("Table_Stok") End Sub

13


Sub mati() cmdsimpan.Enabled = False frameinput.Enabled = False End Sub Sub Hidup() cmdsimpan.Enabled = True frameinput.Enabled = True End Sub Private Sub Auto_Nomor() Dim Urutan As String Dim Kodebaru As String With RsPembelian If .BOF Then txtNomasuk.Text = "PB-001" Exit Sub Else .MoveLast Kodebaru = !No_Masuk Kodebaru = Val(Right(Kodebaru, 3)) Kodebaru = Kodebaru + 1 End If Kodebaru = "PB-" + Format(Kodebaru, "000") txtNomasuk.Text = Kodebaru End With End Sub Private Sub cmbdisc_Click() Dim Diskon As Integer If txtjumlah.Text = "" Or txtharga.Text = "" Then MsgBox "Ada Data yang belum diinputkan", vbCritical, "Err" Else Diskon = Val(txtharga_sement.Text) * Val((cmbdisc.Text) / 100) txttotal.Text = txtharga_sement.Text - Diskon End If End Sub Private Sub cmbIDPemasok_Click() RsPemasok.Index = "idx_pemasok" RsPemasok.Seek "=", cmbIDPemasok.Text If RsPemasok.NoMatch Then MsgBox "ID Pemasok Tidak Ditemukan", vbExclamation, "Error" cmbIDPemasok.Text = Empty cmbIDPemasok.SetFocus Else TxtNamaPemasok.Text = RsPemasok!Nama_pemasok End If

14


End Sub Private Sub cmdbatal_Click() Call Bersih Call mati End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdsimpan_Click() If txtharga.Text = "" Or txttotal.Text = "" Then MsgBox "Data Pembelian Belum Lengkap", vbCritical, "Error" Else RsPembelian.Index = "idx_nomasuk" RsPembelian.Seek "=", txtNomasuk.Text If RsPembelian.NoMatch Then RsPembelian.AddNew 'Sesuaikan Nama Field di Database dan Di Form RsPembelian!No_Masuk = txtNomasuk.Text RsPembelian!Tgl_Pembelian = LblTanggal.Caption RsPembelian!ID_Pemasok = cmbIDPemasok.Text RsPembelian!Nama_pemasok = TxtNamaPemasok.Text RsPembelian!Kode_Barang = txtkode.Text RsPembelian!Nama_Barang = txtnabar.Text RsPembelian!Jumlah = txtjumlah.Text RsPembelian!Harga = txtharga.Text RsPembelian!Discount = cmbdisc.Text RsPembelian!Total_Harga = txttotal.Text RsPembelian.Update Koneksi RsBarang.Index = "idx_kode" RsBarang.Seek "=", txtkode.Text If Not RsBarang.NoMatch Then RsBarang.Edit Stok = RsBarang!Stok RsBarang!Stok = Val(txtjumlah.Text) + Val(Stok) RsBarang.Update End If MsgBox "Berhasil disimpan", vbInformation, "Pesan" Data_Pembelian.Refresh GridPemelian.Refresh Call Bersih Call mati Else MsgBox "Ada Kesalahan dalam penyimpanan", vbExclamation, "Pesan" End If

15


End If End Sub Private Sub cmdtambah_Click() Call Hidup Call Auto_Nomor Call Kode LblTanggal.Caption = Format(Date, "DD-MMMM-YYYY") End Sub Private Sub Form_Load() Call Diskon Call mati Call Koneksi End Sub Sub Kode() RsPemasok.Index = "idx_pemasok" If RsPemasok.NoMatch Then MsgBox "DATA PEMASOK TIDAK ADA", vbOKOnly + vbCritical, "Error" Else cmbIDPemasok.Clear Do Until RsPemasok.EOF cmbIDPemasok.AddItem RsPemasok![ID_Pemasok] RsPemasok.MoveNext Loop RsPemasok.MoveFirst End If End Sub Private Sub TxtDiskon_Change() Dim Diskon As Integer Diskon = Val(TxtDiskon.Text) / 100 * Val(txtharga.Text) txttotal.Text = Val(txtharga.Text) * Val(txtjumlah.Text) - Diskon End Sub

Private Sub txtjumlah_Change() txtharga_sement.Text = Val(txtjumlah.Text) * Val(txtharga.Text) End Sub Private Sub txtkode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If txtkode.Text = Empty Then txtkode.SetFocus: Exit Sub RsBarang.Index = "idx_kode" RsBarang.Seek "=", txtkode.Text If RsBarang.NoMatch Then

16


MsgBox "Kode Barang Tidak Ditemukan", vbExclamation, "Error" txtkode.Text = Empty txtkode.SetFocus Else txtnabar.Text = RsBarang!Nama_Barang txtharga.Text = RsBarang!Harga txtjumlah.SetFocus End If End If End Sub Sub Diskon() cmbdisc.AddItem "0" cmbdisc.AddItem "5" cmbdisc.AddItem "10" cmbdisc.AddItem "15" End Sub Sub Bersih() txtNomasuk.Text = "" LblTanggal.Caption = "" cmbIDPemasok.Text = "" TxtNamaPemasok.Text = "" txtkode.Text = "" txtnabar.Text = "" txtjumlah.Text = "" txtharga.Text = "" txtharga_sement.Text = "" cmbdisc.Text = "" txttotal.Text = "" End Sub

17


Form Penjualan Barang Dim Db As Database Dim RsPelanggan As Recordset Dim RsPenjualan As Recordset Dim RsBarang As Recordset

Sub Koneksi() Set Db = OpenDatabase("Tentukan Lokasi Database\Barang.mdb") Set RsPelanggan = Db.OpenRecordset("Tabel_Pelanggan") Set RsPenjualan = Db.OpenRecordset("Tabel_Penjualan") Set RsBarang = Db.OpenRecordset("Table_Stok") End Sub Sub mati() cmdsimpan.Enabled = False frameinput.Enabled = False End Sub Sub Hidup() cmdsimpan.Enabled = True frameinput.Enabled = True End Sub Private Sub Auto_Nomor() Dim Urutan As String Dim Kodebaru As String With RsPenjualan If .BOF Then txtnota.Text = "PJ-001" Exit Sub Else .MoveLast Kodebaru = !No_Nota Kodebaru = Val(Right(Kodebaru, 3)) Kodebaru = Kodebaru + 1

18


End If

Kodebaru = "PJ-" + Format(Kodebaru, "000") txtnota.Text = Kodebaru End With

End Sub Private Sub cmbID_Pelanggan_Click() RsPelanggan.Index = "idx_pelanggan" RsPelanggan.Seek "=", cmbID_Pelanggan.Text If RsPelanggan.NoMatch Then MsgBox "ID Pelanggan Tidak Ditemukan", vbExclamation, "Error" cmbIDPelanggan.Text = Empty cmbIDPelanggan.SetFocus Else txtnama_pelanggan.Text = RsPelanggan!Nama_Pelanggan End If End Sub Private Sub cmbpot_Click() Dim Potongan As Integer If txtjumlah.Text = "" Or txtharga.Text = "" Then MsgBox "Ada Data yang belum diinputkan", vbCritical, "Err" Else Potongan = Val(txtharga_sement.Text) * Val((cmbpot.Text) / 100) txttotal.Text = txtharga_sement.Text - Potongan End If End Sub Private Sub cmekeluar_Click() Unload Me End Sub

Private Sub cmdbatal_Click() Call Bersih Call mati End Sub

Private Sub cmdsimpan_Click() If txtharga.Text = "" Or txttotal.Text = "" Then MsgBox "Data Penjualan Belum Lengkap", vbCritical, "Error" Else

19


RsPenjualan.Index = "idx_nota" RsPenjualan.Seek "=", txtnota.Text If RsPenjualan.NoMatch Then RsPenjualan.AddNew 'Sesuaikan Nama Field di Database dan Di Form RsPenjualan!No_Nota = txtnota.Text RsPenjualan!Tgl_Penjualan = txttanggal.Text RsPenjualan!ID_Pelanggan = cmbID_Pelanggan.Text RsPenjualan!Nama_Pelanggan = txtnama_pelanggan.Text RsPenjualan!Kode_Barang = txtkode.Text RsPenjualan!Nama_Barang = txtnabar.Text RsPenjualan!Jumlah = txtjumlah.Text RsPenjualan!Harga = txtharga.Text RsPenjualan!Potongan = cmbpot.Text RsPenjualan!Total_Harga = txttotal.Text RsPenjualan.Update Koneksi RsBarang.Index = "idx_kode" RsBarang.Seek "=", txtkode.Text If Not RsBarang.NoMatch Then RsBarang.Edit Stok = RsBarang!Stok RsBarang!Stok = Val(Stok) - Val(txtjumlah.Text) RsBarang.Update End If

MsgBox "Data Berhasil Disimpan", vbInformation, "Pesan" Data_Penjualan.Refresh GridPenjualan.Refresh Call Bersih Call mati Else MsgBox "Ada Kesalahan dalam penyimpanan", vbExclamation, "Pesan" End If End If End Sub Private Sub cmdtambah_Click() Call Hidup Call Auto_Nomor Call Kode txttanggal.Text = Format(Date, "DD-MMMM-YYYY") End Sub Private Sub Form_Load() Call Potongan

20


Call mati Call Koneksi End Sub Sub Kode() RsPelanggan.Index = "idx_pelanggan" If RsPelanggan.NoMatch Then MsgBox "DATA PELANGGAN TIDAK ADA", vbOKOnly + vbCritical, "Error" Else cmbID_Pelanggan.Clear Do Until RsPelanggan.EOF cmbID_Pelanggan.AddItem RsPelanggan![ID_Pelanggan] RsPelanggan.MoveNext Loop RsPelanggan.MoveFirst End If End Sub Sub Potongan() cmbpot.AddItem "0" cmbpot.AddItem "5" cmbpot.AddItem "10" cmbpot.AddItem "20" End Sub

Private Sub txtjumlah_Change() txtharga_sement.Text = Val(txtjumlah.Text) * Val(txtharga.Text) End Sub Private Sub txtkode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If txtkode.Text = Empty Then txtkode.SetFocus: Exit Sub RsBarang.Index = "idx_kode" RsBarang.Seek "=", txtkode.Text If RsBarang.NoMatch Then MsgBox "Kode Barang Tidak Ditemukan", vbExclamation, "Error" txtkode.Text = Empty txtkode.SetFocus Else txtnabar.Text = RsBarang!Nama_Barang txtharga.Text = RsBarang!Harga txtjumlah.SetFocus End If End If End Sub Sub Bersih()

21


txtnota.Text = "" txttanggal.Text = "" cmbID_Pelanggan.Text = "" txtnama_pelanggan.Text = "" txtkode.Text = "" txtnabar.Text = "" txtjumlah.Text = "" txtharga.Text = "" txtharga_sement.Text = "" cmbpot.Text = "" txttotal.Text = "" End Sub

22


MENU UTAMA

Kode Menu Utama Private Sub mnubarang_Click() frmBarang.Show End Sub Private Sub mnubeli_Click() frmpembelian.Show End Sub Private Sub mnuclose_Click() End End Sub Private Sub mnujual_Click() frmpenjualan.Show End Sub Private Sub mnulapbeli_Click() crLaporan.ReportFileName = App.Path + "\LaporanPembelian.rpt" crLaporan.DiscardSavedData = True crLaporan.WindowState = crptMaximized crLaporan.Action = 1 End Sub

23


Private Sub mnulapbrg_Click() crLaporan.ReportFileName = App.Path + "\LaporanBarang.rpt" crLaporan.DiscardSavedData = True crLaporan.WindowState = crptMaximized crLaporan.Action = 1 End Sub Private Sub mnulapjual_Click() crLaporan.ReportFileName = App.Path + "\LaporanPenjualan.rpt" crLaporan.DiscardSavedData = True crLaporan.WindowState = crptMaximized crLaporan.Action = 1 End Sub Private Sub mnulapmasok_Click() crLaporan.ReportFileName = App.Path + "\LaporanPemasok.rpt" crLaporan.DiscardSavedData = True crLaporan.WindowState = crptMaximized crLaporan.Action = 1 End Sub Private Sub mnulapplg_Click() crLaporan.ReportFileName = App.Path + "\LaporanPelanggan.rpt" crLaporan.DiscardSavedData = True crLaporan.WindowState = crptMaximized crLaporan.Action = 1 End Sub Private Sub mnupelanggan_Click() frmpelanggan.Show End Sub Private Sub mnupemasok_Click() frmpemasok.Show End Sub

24


Contoh Laporan Stok Barang

Contoh Laporan Pelanggan

25


Copyright by : ipi-leppindo jambi all reserved 2014 (japikinfo.com)

Recommend Documents