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
Sekian Dulu ya.....semoga bermanfaat...
By Willh Nobis, Amik Hass Bandung
Tidak ada komentar:
Posting Komentar