Program STOK Barang menggunakan VB dan Microsoft Access (Episode 5A)

Bagian Pembelian dan STOK Barang

Pada Episode sebelumnya (Epesiode 4) telah dibahas cara mengkoneksikan Visual Basic ke Database (MS Acces) dan bagaimana cara memanajemen record database menggunakan ADO (ActiveX Data Objects).

Program Stok kali ini lebih nyata dalam pemrograman dan tetap menjadi media belajar yang santai karena terdapat banyak peluang untuk memperbaiki sesuai dengan logika pembaca. Misalkan pada Pembelian (HBeli) digunakan field KODESUP untuk Suplier sedangkan pada tabel Penjualan (Hjual) digunakan field nama CUSTOMER padahal tabel CUSTOMER (TCUSTOMER) terdapat field KodeCust, tentunya diharapkan para pembaca yang memodifikasi program dan Database agar yang tersimpan adalah kode Customer sebagai mana layaknya basidata yang baik. Secara Umum untuk memperoleh STOK adalah dengan menghitung semua Pembelian dan dikurangkan dengan semua Penjualan seperti ditulis dalam rumus dibawah ini:

Stok = Pembelian – Penjualan

Pada praktiknya agar stok bersifat Real Time maka setiap terjadi transaksi Pembelian maka field JUMLAH pada Tabel Barang akan di tambahkan dengan jumlah barang yang dibeli. Begitu juga sebaliknya setiap terjadi transaksi Penjualan maka field JUMLAH akan dikurangkan dengan Jumlah barang yang dijual. Rumus diatas dituangkan dalam rancangan Basisdata Database Stok menggunakan Ms. Access 2003 sbb:

Database Name : STOK.MDB
Tabel-Tabel sebagai berikut:
1. TBarang (Tabel Master dan Stok Barang)
2. HBeli (Tabel Header Pembelian)
3. DBeli (Tabel Detail Pembelian)
4. HJual (Tabel Header Penjualan)
5. Djual (Tabel Detail Penjualan)
6. TSupplier (Tabel Master Supplier)
7. TCustomer (Tabel Master Customer)
8. Tbantu (Tabel Bantu Form Transaksi Pembelian dan Penjualan)

Selain menggunakan tabel-tabel diatas maka pada database digunakan juga bebera query untuk memudahkan manipulasi data yakni sbb:

1. QBeli (Query transaksi Pembelian)
2. QJBeli (Query untuk menghitung Jumlah Pembelian)
3. QJual (Query transaksi Penjualan)
4. QJJual (Query untuk menghitung Jumlah Penjualan)
5. QJMLBRG (Query untuk menghitung Stok Barang)

Pada Bagian ini akan dibahas mengenai struktur tabel dan query database Stok.MDB: 1. TBarang, Struktur tabel ini sbb:

Field Name	Data Type	Field Properties
KODEBRG	Text	Field Size 18
NAMA BRG	Text	Field Size 100
SATUAN	Text	Fiel Size 15
JUMLAH	Number	Integer
HARGABELI	Number	Single
HARGAJUAL	Number	Single

Buatkan index dengan nama XKODEBRG dari field KODEBRG yang bersifat Primarykey

2. Hbeli, Untuk menampung data transaksi Pembelian maka dibuatkan 2 Tabel (HBeli dan DBeli), ke 2 tabel dihubungkan dengan sebuah field kunci yakni NOFAKTUR.

Mungkin dari pembaca ada yang bertanya mengapa harus 2 tabel..?,

Jawabannya adalah:

Agar diperoleh Basis Data yang baik maka hindarkan hal-hal yang akan menyebabkan kesalahan dan kesulitan dalam mengakses dan memanipulasi database seperti annomaly, redudance (Field berulang), dsb.

Untuk keperluan tersebut maka Data-data yang bersifat tunggal (One) seperti Tanggal Transaksi, Kode Suplier, Keterangan dsb dicatat dalam tabel HBeli, sementara data-data yang berulang-ulang (Many) dalam hal ini record barang yang dibeli (KODEBRG, JML, HARGA BELI) dicatat dalam tabel DBeli.

Jadi sekali transaksi dapat membeli lebih dari 1 barang, Relasi HBeli dan DBeli disebut “One to Many”

Struktur tabel Hbeli ini sbb:

Field Name	Data Type	Field Properties
NOFAKTUR	Text	Field Size 10, (Nomor Faktur Pembelian)
TGL	Date/Time	Field Size 8 otomatis (Tanggal Transaksi Pembelian)
KODESUP	Text	Field Size 5, (Kode Supplier)
KETERANGAN	Text	Field Size 100 (Mencatat Keterangan Transaksi)

Buatkan index dengan nama XNOFAKTUR dari field NOFAKTUR yang bersifat Primarykey

3. DBeli, Untuk menampung data many transaksi Pembelian, Struktur Tabel DBeli ini sbb:

Field Name	Data Type	Field Properties
NOFAKTUR	Text	Field Size 10, (Nomor Faktur Pembelian)
KODEBRG	Text	Field Size 18 (Kode Barang)
JML	Number	Integer,(Jumlah Barang yang di beli)
HARGA	Number	Single (Harga Beli Barang)

Field Nofaktur dapat di index akan tetapi tidak boleh bersifat Primarykey

4.TSupplier, Untuk menampung data Master Supplier,  Struktur Tabel TSupplier sbb:

Field Name	Data Type	Field Properties
KODESUP	Text	Field Size 5, (Kode Supplier)
NAMASUP	Text	Field Size 100 (Nama Supplier)
ALAMAT	Text	Field Size 255,(Alamat Supplier)
TELEPON	Text	Field Size 15(Nomor Telepon Supplier)
KONTAK	Text	Field Size 50(Kontak Person Supplier)

Buatkan index dengan nama XKODESUP dari field KODESUP yang bersifat Primarykey

5. QBELI, Adalah query untuk menampilkan record data pembelian,

Adapun struktur Query ini adalah melibatkan ke 4 tabel yang sudah dibuat diatas,lihat gambar dibawah ini:

Bila kesulitan membaca gambar maka dapat menempuh cara membuat query dengan mengcopy isi

statement SQLnya melalui menu SQL View. Adapun SLQ Stringnya seperti dibawah ini:

SELECT HBELI.NOFAKTUR, HBELI.TGL, HBELI.KODESUP, TSUPPLIER.NamaSup, HBELI.KETERANGAN, DBELI.KODEBRG, TBARANG.NAMABRG,TBARANG.SATUAN, DBELI.JML, DBELI.HARGA, [DBELI]![JML]*[DBELI]![HARGA] AS SUBJUMLAH FROM (DBELI INNER JOIN (TSUPPLIER INNER JOIN HBELI ON TSUPPLIER.KodeSup = HBELI.KODESUP) ON DBELI.NOFAKTUR = HBELI.NOFAKTUR) INNER JOIN TBARANG ON DBELI.KODEBRG = TBARANG.KODEBRG;

Catatan:

Baris perintah diatas tidak dipisahkan dengan enter, hilangkan dahulu efek enter tersebut dengan menekan tombol del di setiap diujung baris perintah.

6. QJBELI, Adalah query untuk menghitung jumlah pembelian masing2 barang,

Adapun struktur Query berasal dari query QBELI, lihat gambar dibawah ini:

Keterangan:

Bila kesulitan membaca gambar maka dapat menempuh cara membuat query dengan mengcopy isi statement SQLnya melalui menu SQL View. Adapun SLQ Stringnya seperti dibawah ini:

SELECT QBELI.KODEBRG, QBELI.NAMABRG, Sum(QBELI.JML) AS JMLBELI, Sum(QBELI.HARGA) AS HARGABELI, Sum(QBELI.SUBJUMLAH) AS SUBJUMLAHBELI FROM QBELI GROUP BY QBELI.KODEBRG, QBELI.NAMABRG;

Catatan:

Baris perintah diatas tidak dipisahkan dengan enter, hilangkan dahulu efek enter tersebut dengan menekan tombol del diujung baris perintah sehingga baris ke dua naik menyambung dengan baris pertama.

PROGRAM STOK

Perancangan program dimulai dengan membuat Project baru dan beri nama STOK, selanjutnya tambahkan modul dengan nama Modul1 (secara default VB akan memberikan nama ini).

Isi modul1.bas seperti dibawah ini Public VFrmbeli As Boolean
'------ BOF Modul1.bas ---------------------------------------
   Public VFrmJual As Boolean
   Public CN As ADODB.Connection
   Public rSB As ADODB.Recordset 'Recordset Barang
   Public rSDBeli As ADODB.Recordset 'Recordset Dbeli
   Public rsHBeli As ADODB.Recordset 'Recordset Hbeli
   Public rSDJual As ADODB.Recordset 'Recordset Djual
   Public rsHJual As ADODB.Recordset 'Recordset Hjual
   Public rSBantu As ADODB.Recordset 'Recordset Tbantu 

'Sub program ini untuk merubah penekanan tombol enter bernilai TAB 

Sub TekanEnter(Ntekan)
  If Ntekan = 13 Then
     SendKeys "{TAB}"
     Ntekan = 0
  End If End Sub

' Awal startup program...
  Sub Main()
  Set CN = New ADODB.Connection
    CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=STOK.mdb;
             Persist Security Info=False
    MDIForm1.Show
  End Sub
'-------------- EOF Modul1.BAS ----------------

FRMBELI (Form Pembelian) Form ini digunakan untuk melakukan transaksi pembelian, Desain dan Layout form seperti gambar dibawah:

frmbeli megadata ce indonesia
Penjelasan:

'General Declarations
 Public Mtotal As Single
 Public RBaru As Boolean
 Public SubHLama As Single 

'Hapus Tbantu
Sub HapusTbantu()
  If Adodc1.Recordset.State = 1 Then
   Adodc1.Recordset.Close
  End If
  CN.Execute "delete * from Tbantu"
  Adodc1.Recordset.Open "SELECT * FROM TBANTU", CN
  Adodc1.Refresh
  Me.DataGrid1.ReBind
  Me.DataGrid1.Refresh
End Sub 

' sub rutin ini memeriksa apakah user melakukan edit data pada datagrid
' ini penting untuk deteksi total harga

Private Sub Adodc1_WillChangeRecord(ByVal adReason As
  ADODB.EventReasonEnum, ByVal cRecords As Long,
  adStatus As ADODB.EventStatusEnum, ByVal pRecordset
  As ADODB.Recordset)
' Paramater diatas tidak dipisahkan dengan enter
  If adReason = adRsnAddNew Then
    RBaru = True
  Else
    RBaru = False
  End If
End Sub

' fungsi = diatas
Private Sub Adodc1_WillChangeRecordset(ByVal adReason As
    ADODB.EventReasonEnum, adStatus As ADODB.EventStatusEnum,
    ByVal pRecordset As ADODB.Recordset)
    'Variabel diatas tidak dipisahkan dengan enter
  If adReason = adRsnAddNew Then
    RBaru = True
  Else
   RBaru = False
  End If
End Sub

Private Sub cadd_Click()
   Me.Text1.Text = ""
   Me.Text2.Text = ""
   Me.Text3.Text = ""
   Me.Text4.Text = ""
   Me.Text5.Text = ""
   cESave.Caption = "&Save"
   Call HapusTbantu
  ' agar grid tidak empty (kosong) tambahkan 1 record data hidari
  ' error number 6016  
   Adodc1.Recordset.AddNew
   Adodc1.Recordset!KOdeBrg = ""
   Adodc1.Recordset.Update
   Me.Refresh
   Text1.SetFocus
   Mtotal = 0
End Sub

Private Sub cESave_Click()
  If cESave.Caption = "&Save" Then
   cESave.Caption = "&Edit"
   Set rsHBeli = New ADODB.Recordset
   rsHBeli.Open "select * from HBeli", CN, adOpenKeyset,
                 adLockOptimistic,adCmdText
   rsHBeli.AddNew
   rsHBeli!NoFaktur = Trim(Text1.Text)
   rsHBeli!tgl = DtBeli.Value
   rsHBeli!KodeSup = Trim(Text2.Text)
   rsHBeli!keterangan = Trim(Text3.Text)

   Set rSDBeli = New ADODB.Recordset
   rSDBeli.Open "select * from DBeli ", CN,
                 adOpenKeyset, adLockOptimistic,adCmdText
   With Adodc1.Recordset
     .MoveFirst
    Do Until .EOF
       If Len(Trim(!KOdeBrg)) > 0 Then
         rSDBeli.AddNew
         rSDBeli!NoFaktur = Trim(Text1.Text)
         rSDBeli!KOdeBrg = !KOdeBrg
         rSDBeli!Jml = !Jml
         rSDBeli!Harga = !HrgJual

       Set rSB = New ADODB.Recordset
       rSB.Open "select * from Tbarang where KODEBRG='" &
                 !KOdeBrg & "'", CN, adOpenKeyset, adLockOptimistic,
                 adCmdText
                 'Variabel diatas tidak dipisahkan dengan enter
         If rSB.EOF And rSB.BOF Then
         Else
           ' ini perintah mengedit JUMLAH barang pada tabel Tbarang
           rSB!JUMLAH = rSB!JUMLAH + !Jml
           rSB.Update
         End If
         rSDBeli.Update
       End If
      .MoveNext
    Loop
   'Yakin jika ada Detail baru Hbeli di update
    rsHBeli.Update
   End With
   MsgBox "Data Pembelian sudah tersimpan"
  End If
 End Sub

Private Sub cexit_Click()
   Unload Me
End Sub

Private Sub DataGrid1_AfterColEdit(ByVal ColIndex As Integer)
   Dim Kobrg As String
   If ColIndex = 0 Then
    Kobrg = Trim(DataGrid1.Columns(0).Text)
    Set rSB = New ADODB.Recordset
    rSB.Open "select * from Tbarang where KodeBrg ='" & Kobrg & "'",
              CN, adOpenKeyset, adLockOptimistic, adCmdText
              'Parameter diatas tidak dipisahkan dengan enter
    If rSB.EOF And rSB.BOF Then
      MsgBox "Kode Barang ini tidak ada"
    Else
      With DataGrid1
       .Columns(1).Text = rSB!NamaBrg
       .Columns(2).Text = rSB!Satuan
       .Columns(3).Text = rSB!HargaBeli
      End With
      'Tekan tombol Right 4 kali
      SendKeys "{RIGHT 4}"
    End If
   End If

  If ColIndex = 4 Then
   With DataGrid1
    .Columns(5).Text = Val(.Columns(3).Text) * Val(.Columns(4).Text)

    If RBaru Then
      Mtotal = Mtotal + Val(.Columns(5).Text)
    Else
     'Jika bukan data baru maka Mtotal harus dikurangi dengan
     'Subharga yang lama
 
     Mtotal = (Mtotal - SubHLama) + Val(.Columns(5).Text)
    End If
    SubHLama = 0
    Text4.Text = Format(Mtotal, "#,##0")
   End With
   SendKeys "{DOWN}"
   SendKeys "{HOME}"
  End If
End Sub

Private Sub DataGrid1_BeforeColEdit(ByVal ColIndex As Integer,
                   ByVal KeyAscii    As Integer, Cancel As Integer)
                   'Variabel tidak dipisahkan dengan enter
  If ColIndex = 4 Then
   SubHLama = Val(DataGrid1.Columns(5).Text)
  End If End
Sub

Private Sub DtBeli_KeyDown(KeyCode As Integer, Shift As Integer)
   TekanEnter (KeyCode)
End Sub

Private Sub Form_Load()
   VFrmbeli = True
   Me.Width = 9420
   Me.Height = 5550
   Me.Left = (Screen.Width - Me.Width) \ 2
   Me.Top = 1000

   Adodc1.Recordset.Close
   CN.Execute "delete * from Tbantu"
   Adodc1.Recordset.Open "select * from Tbantu"
   Me.Adodc1.Refresh
   Me.DataGrid1.Refresh
End Sub

Private Sub Form_Unload(Cancel As Integer)
   VFrmbeli = False
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
   KeyAscii = Asc(UCase(Chr(KeyAscii)))
   TekanEnter (KeyAscii)
End Sub

Private Sub Text1_LostFocus()
 Dim Tanya As Integer
 Mtotal = 0
 If Len(Trim(Text1.Text)) > 0 Then
   Set rsHBeli = New ADODB.Recordset
   rsHBeli.Open "select * from QBELI where NOFAKTUR ='" & Trim
    (Text1.Text) & "'", CN, adOpenKeyset, adLockOptimistic, adCmdText
    'Variabel diatas tidak dipisahkan dengan enter 

   If rsHBeli.EOF And rsHBeli.BOF Then
   Else
     cESave.Caption = "&Edit"
     Tanya = MsgBox("Faktur Sudah pernah ada, Mau ditampilkan.? ",
                     vbQuestion + vbYesNo, "FAKTUR GANDA")
                    'Variabel diatas tidak dipisahkan dengan enter 

     If Tanya = vbYes Then
      Text2.Text = rsHBeli!KodeSup
      DtBeli.Value = rsHBeli!tgl
      Text3.Text = rsBeli!keterangan
      Text5.Text = rsHBeli!NamaSup
      CN.Execute "delete * from Tbantu"
      Set rSBantu = New ADODB.Recordset
      rSBantu.Open "select * from Tbantu", CN, adOpenKeyset,
                    adLockOptimistic,adCmdText
                    'Variabel tidak dipisahkan dengan enter
     rsHBeli.MoveFirst
      Do Until rsHBeli.EOF
       rSBantu.AddNew
       rSBantu!KOdeBrg = rsHBeli!KOdeBrg
       rSBantu!NamaBrg = rsHBeli!NamaBrg
       rSBantu!Satuan = rsHBeli!Satuan
       rSBantu!HrgJual = rsHBeli!Harga
       rSBantu!Jml = rsHBeli!Jml
       rSBantu!Subjumlah = rsHBeli!Subjumlah
       Mtotal = Mtotal + rsHBeli!Subjumlah
       rSBantu.Update
       rsHBeli.MoveNext
      Loop
      Set rsHBeli = Nothing
      Set rSBantu = Nothing
      Adodc1.Recordset.Close
      Adodc1.Recordset.Open "sELECT * FROM TBANTU", CN
      Adodc1.Recordset.Requery -1
      Adodc1.Refresh
      DataGrid1.ReBind
      DataGrid1.Refresh
      Text4.Text = Format(Mtotal, "#,##0")
      Me.Refresh
    End If
   End If
 End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
   KeyAscii = Asc(UCase(Chr(KeyAscii)))
   TekanEnter (KeyAscii)
End Sub

Private Sub Text2_LostFocus()
   Dim RsSup As ADODB.Recordset
   Set RsSup = New ADODB.Recordset
   RsSup.Open "select * from TSUPPLIER where KodeSup ='" &
        Trim(Text2.Text) & "'", CN, adOpenForwardOnly, adLockReadOnly
   If RsSup.EOF And RsSup.BOF Then
     MsgBox "Maaf Kode Supplier ini tidak ada"
     Text2.SetFocus
     Exit Sub
    Else
     Text5.Text = RsSup!NamaSup
   End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
   KeyAscii = Asc(UCase(Chr(KeyAscii)))
   TekanEnter (KeyAscii)
End Sub
'--------- EOF File Form Transaksi ---------------

PENJELASAN:

Pada Source Program yg di download terdapat form tambahan seperti form Input Barang (FrmTBarang, FrmTSupplier, FrmTCustomer), form ini dibuat dengan menggunakan Menu VB Data Form Wizard, dimana dengan menu ini hanya dibutuhkan untuk mengarahkan database (STOK.MDB) sebagai sumber databasenya

Demikian pembahasan transaksi pembelian dan akan dilanjutkan pada bagian ke dua tulisan ini untuk membahas transaksi penjualan dan menampilkan data pada komputer.

Silakan meninggalkan pesan untuk sesuatu yang perlu dijelaskan..

Klik ini untuk Download Source program: