Belajar Pemograman Yuuk (VB 6.0, SQL Server, PostgreSQL, PHP)

Form Transaksi kita dalam Aplikasi Inventori, terbagi menjadi 2 yaitu,
1. Transaksi pembelian barang atau mutasi barang masuk
2. Transaksi penjualan atau mutasi barang keluar

Untuk melengkapi kebutuhan tersebut kita harus menyediakan tabel tambahan sebanyak 4 buah
dengan spesifikasi sbb :
1. tbNotaBeli
2. tbNotaBeliDetail
3. tbNotaJual
4. tbNotaJualDetail

berikut struktur tablenya

Table Name : tbNotaBeli
No.	Field Name	Type Data	Length	Description	Allow Nulls
1	NoNota	text	10		0
2	Tanggal	date/time			0
3	KodePemasok	text	10
4	NamaPemasok	text	50
5	SubTotal	number		Double
6	Potongan	number		Double
7	TotalAkhir	number		Double
8	Keterangan	text	25
Table Name : tbNotaBeliDetail
No.	Field Name	Type Data	Length	Description	Allow Nulls
1	NoNota	text	10
2	KodeBarang	text	10
3	NamaBarang	text	50
4	HargaBeli	number		double
5	Satuan	text	10
6	Jumlah	number		double
7	Total	number		double
Table Name : tbNotaJual
No.	Field Name	Type Data	Length	Description	Allow Nulls
1	NoNota	text	10		0
2	Tanggal	date/time			0
3	KodePelanggan	text	10
4	NamaPelanggan	text	50
5	SubTotal	number		Double
6	Potongan	number		Double
7	TotalAkhir	number		Double
8	Keterangan	text	25
Table Name : tbNotaJualDetail
No.	Field Name	Type Data	Length	Description	Allow Nulls
1	NoNota	text	10
2	KodeBarang	text	10
3	NamaBarang	text	50
4	HargaBeli	number		double
5	Satuan	text	10
6	Jumlah	number		double
7	Total	number		double

Sekarang kita buat form pembelian, berikut layout form pembelian


Cara membuat form pembelian, komponen yang kita butuhkan antara lain
==> DTPicker untuk tanggal
==> ADO Data Control
==> Data Grid
==> Label dan TextBox
==> Masked Edit Box

Tambahkan form baru dan simpan dengan nama frm_beli, atur layout seperti gambar diatas.
Berikut Script untuk form pembelian.

Dim Cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset

'Total Pembelian
Dim Total As Double

Private Sub CmdBatal_Click()
Dim Msql As String

TNota.Enabled = True
TKPemasok.Enabled = True
TNPemasok.Enabled = True
TKeterangan.Enabled = True
MseSubTotal.Enabled = True
MsePotongan.Enabled = True
MseTotal.Enabled = True

TKBarang.Enabled = True
TNBarang.Enabled = True
TSatuan.Enabled = True
MseHarga.Enabled = True
MseJumlah.Enabled = True

'Menghapus record pada tabel
Msql = "Delete From tbNotaBeliDetail " & _
" Where NoNota='" & TNota.Text & "'"

'Mengeksekusi perintah SQL
Cnn.Execute (Msql)

Call Kosong
Call Detail

CmdHapus.Enabled = False
CmdBatal.Enabled = False
CmdSimpan.Enabled = False

End Sub

Private Sub CmdHapus_Click()
Dim Konfirmasi, KodeBrg, NamaBrg, Satuan As String
Dim Jumlah As Double
Dim rs1 As New ADODB.Recordset
Dim Msql As String

If TNota.Text <> "" And TNota.Enabled = False Then
Cnn.BeginTrans

Konfirmasi = MsgBox("Mau Hapus Record ???", vbYesNo + vbCritical, "Konfirmasi")
If Konfirmasi = vbYes Then
'Mencari No Nota
Msql = "Select * From tbNotaBeliDetail " & _
" Where NoNota='" & TNota.Text & "'"

Set rs = Cnn.Execute(Msql)

'Jika No. Nota ditemukan
If Not rs.EOF Then
rs.MoveFirst

Do While Not rs.EOF

KodeBrg = rs.Fields("KodeBarang")
Jumlah = rs.Fields("Jumlah")

'Mencari Kode Barang pada Stok
Msql = "Select * From tbStok " & _
" Where KodeBarang='" & KodeBrg & "'"

Set rs1 = Cnn.Execute(Msql)

'Jika Kode Barang ditemukan
If Not rs1.EOF Then

'Mengurangi Jumlah Stok Barang
Msql = "Update tbStok Set " & _
" Jumlah=Jumlah - " & Val(Jumlah) & "" & _
"Where KodeBarang='" & KodeBrg & "'"

Cnn.Execute (Msql)
End If
rs1.Close

If Not rs.EOF Then
rs.MoveNext
End If
Loop
End If

rs.Close

'Menghapus record pada tabel NotaBeli
Msql = "Delete From tbNotaBeli " & _
" Where NoNota='" & TNota.Text & "'"

'Mengeksekusi perintah SQL
Cnn.Execute (Msql)

'Menghapus record pada tabel NotaBeliDetail
Msql = "Delete From tbNotaBeliDetail " & _
" Where NoNota='" & TNota.Text & "'"

'Mengeksekusi perintah SQL
Cnn.Execute (Msql)

TNota.Enabled = True
TKPemasok.Enabled = True
TNPemasok.Enabled = True
TKeterangan.Enabled = True
MseSubTotal.Enabled = True
MsePotongan.Enabled = True
MseTotal.Enabled = True

TKBarang.Enabled = True
TNBarang.Enabled = True
TSatuan.Enabled = True
MseHarga.Enabled = True
MseJumlah.Enabled = True

CmdTambah.Enabled = False
CmdSimpan.Enabled = False
CmdHapus.Enabled = False
CmdBatal.Enabled = False

Call Kosong
Call Detail

Cnn.CommitTrans
End If

End If
End Sub

Private Sub CmdSelesai_Click()

Set rs = Nothing
Set rs1 = Nothing

Unload Me

Call Menu_Bisa

End Sub

Private Sub CmdSimpan_Click()
Dim KodeBrg, NamaBrg, Satuan As String
Dim Jumlah As Double
Dim rs1 As New ADODB.Recordset
Dim Msql As String

If TNota.Text <> "" Then
Cnn.BeginTrans

'Mencari No Nota
Msql = " Select * From tbNotaBeliDetail " & _
" Where NoNota='" & TNota.Text & "'"

Set rs = Cnn.Execute(Msql)

'Jika No. Nota ditemukan
If Not rs.EOF Then
rs.MoveFirst

Do While Not rs.EOF

KodeBrg = rs.Fields("KodeBarang")
NamaBrg = rs.Fields("NamaBarang")
Satuan = rs.Fields("Satuan")
Jumlah = rs.Fields("Jumlah")

'Mencari Kode Barang pada Stok
Msql = "Select * From tbStok " & _
" Where KodeBarang='" & KodeBrg & "'"

Set rs1 = Cnn.Execute(Msql)

'Jika Kode Barang tidak ditemukan
If rs1.EOF Then

'Isi Jumlah Barang pada Stok
Msql = "Insert Into tbStok (KodeBarang, NamaBarang, " & _
" Satuan, Jumlah) " & _
" Values('" & KodeBrg & "','" & NamaBrg & "'," & _
"'" & Satuan & "'," & Val(Jumlah) & ")"

Cnn.Execute (Msql)

'Jika Kode Barang ada
Else
'Ubah Jumlah Barang pada Stok
Msql = "Update tbStok set " & _
" Jumlah=Jumlah + " & Val(Jumlah) & "" & _
" Where KodeBarang='" & KodeBrg & "'"

Cnn.Execute (Msql)

End If
rs1.Close

If Not rs.EOF Then
rs.MoveNext
End If

Loop
End If

rs.Close

'Menambah record pada tabel NotaBeli
Msql = "Insert into tbNotaBeli(NoNota, Tanggal, KodePemasok, " & _
" NamaPemasok, Keterangan, SubTotal, Potongan, TotalAkhir) " & _
" Values('" & TNota.Text & "','" & dpTanggal.Value & "', " & _
" '" & TKPemasok.Text & "','" & TNPemasok.Text & "'," & _
" '" & TKeterangan.Text & "'," & Val(MseSubTotal.Text) & "," & _
" " & Val(MsePotongan.Text) & "," & Val(MseTotal.Text) & ")"

'Mengeksekusi perintah SQL
Cnn.Execute (Msql)

TNota.Enabled = False
TKPemasok.Enabled = False
TNPemasok.Enabled = False
TKeterangan.Enabled = False
MseSubTotal.Enabled = False
MsePotongan.Enabled = False
MseTotal.Enabled = False

TKBarang.Enabled = False
TNBarang.Enabled = False
TSatuan.Enabled = False
MseHarga.Enabled = False
MseJumlah.Enabled = False

CmdTambah.Enabled = True
CmdSimpan.Enabled = True

CmdHapus.Enabled = True
CmdBatal.Enabled = False


Cnn.CommitTrans
End If

End Sub

Private Sub CmdTambah_Click()

TNota.Enabled = True
TKPemasok.Enabled = True
TNPemasok.Enabled = True
TKeterangan.Enabled = True
MseSubTotal.Enabled = True
MsePotongan.Enabled = True
MseTotal.Enabled = True

TKBarang.Enabled = True
TNBarang.Enabled = True
TSatuan.Enabled = True
MseHarga.Enabled = True
MseJumlah.Enabled = True

CmdTambah.Enabled = False
CmdSimpan.Enabled = False
CmdHapus.Enabled = False
CmdBatal.Enabled = False

Call Kosong
Call Detail

TNota.SetFocus

End Sub

Private Sub Form_Activate()
TNota.SetFocus
End Sub

Private Sub Form_Load()
'Dim Koneksi As String

'Driver ODBC Connection String
'Koneksi = "Driver={Microsoft Access Driver(*.mdb)};" & _
' "Dbq=inventori.mdb;" & _
' "DefaultDir=D:\LatihanVB\Inventori;" & _
' "Uid=Admin;Pwd=;"

'Membuka Koneksi dengan ODBC Driver Aplikasi
'Cnn.Open Koneksi

Set Cnn = New ADODB.Connection

Cnn.Open "inventori"

Call Detail

dgDetail.Refresh

CmdTambah.Enabled = False
CmdSimpan.Enabled = False

CmdHapus.Enabled = False
CmdBatal.Enabled = False

Total = 0

Me.Top = (Main.ScaleHeight - Me.ScaleHeight) / 2
Me.Left = (Main.ScaleWidth - Me.ScaleWidth) / 2

End Sub

Private Sub Form_Unload(Cancel As Integer)
Cnn.Close

Set Cnn = Nothing
End Sub

Private Sub MseHarga_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub MseJumlah_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub MseJumlah_LostFocus()
Dim Msql As String
Dim TotalBrg As Double

If TKBarang.Text <> "" Then

Cnn.BeginTrans

'Total Harga Per Barang
TotalBrg = Val(MseHarga.Text) * Val(MseJumlah.Text)

'Total Harga Pembelian
Total = Total + TotalBrg

'Menambah Record pada Tabel NotaBeliDetail
Msql = "Insert into tbNotaBeliDetail(NoNota, KodeBarang," & _
" NamaBarang, HargaBeli, Satuan, Jumlah, Total)" & _
" Values('" & TNota.Text & "','" & TKBarang.Text & "','" & TNBarang.Text & "'," & Val(MseHarga.Text) & "," & _
" '" & TSatuan.Text & "'," & Val(MseJumlah.Text) & ", " & Val(TotalBrg) & ")"

Cnn.Execute (Msql)

Cnn.CommitTrans

Call Detail

TKBarang.SetFocus

TKBarang.Text = ""
TNBarang.Text = ""
TSatuan.Text = ""
MseHarga.Text = ""
MseJumlah.Text = ""

MseSubTotal.Text = Total
MseTotal.Text = Total

End If
End Sub

Private Sub MsePotongan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub MsePotongan_LostFocus()

'Harga Sub Total dikurangi potongan
MseTotal.Text = Total - Val(MsePotongan.Text)

End Sub

Private Sub MseSubTotal_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub TKBarang_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Private Sub TKBarang_LostFocus()
Dim Msql As String

If TKBarang.Text <> "" Then

'Mencari Kode Barang
Msql = "Select * From tbBarang " & _
"Where Kode='" & TKBarang.Text & "'"

Set rs = Cnn.Execute(Msql)

'Jika Kode Barang Ada
If Not rs.EOF Then
TNBarang.Text = rs.Fields("Nama")
MseHarga.Text = rs.Fields("HargaBeli")
TSatuan.Text = rs.Fields("Satuan")
MseJumlah.SetFocus
End If
rs.Close
End If

End Sub

Private Sub TKeterangan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Private Sub TKPemasok_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Private Sub TKPemasok_LostFocus()
Dim Msql As String

If TKPemasok.Text <> "" Then

'Mencari Kode Barang
Msql = "Select * From tbPemasok " & _
"Where Kode='" & TKPemasok.Text & "'"

Set rs = Cnn.Execute(Msql)

'Jika Kode Barang Ada
If Not rs.EOF Then
TNPemasok.Text = rs.Fields("Nama")
End If
rs.Close
End If

End Sub

Private Sub TNBarang_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Private Sub TNota_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Private Sub TNota_LostFocus()
Dim Msql As String

If TNota.Text <> "" Then

Cnn.BeginTrans

'Mencari NoNota pada tabel NotaBeli
Msql = "Select * From tbNotaBeli " & _
"Where NoNota='" & TNota.Text & "'"

Set rs = Cnn.Execute(Msql)

'Jika NoNota Ada
If Not rs.EOF Then
dpTanggal.Value = rs.Fields("Tanggal")
TKPemasok.Text = rs.Fields("KodePemasok")
TNPemasok.Text = rs.Fields("NamaPemasok")
TKeterangan.Text = rs.Fields("Keterangan")
MseSubTotal.Text = rs.Fields("SubTotal")
MsePotongan.Text = rs.Fields("Potongan")
MseTotal.Text = rs.Fields("TotalAkhir")

Call Detail

TNota.Enabled = False
TKPemasok.Enabled = False
TNPemasok.Enabled = False
TKeterangan.Enabled = False
MseSubTotal.Enabled = False
MsePotongan.Enabled = False
MseTotal.Enabled = False

TKBarang.Enabled = False
TNBarang.Enabled = False
TSatuan.Enabled = False
MseHarga.Enabled = False
MseJumlah.Enabled = False

CmdTambah.Enabled = True
CmdHapus.Enabled = True
CmdBatal.Enabled = True

Else

CmdSimpan.Enabled = True

End If

rs.Close

Cnn.CommitTrans

End If

End Sub

Private Sub TNPemasok_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Private Sub TSatuan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Sub Kosong()
TNota.Text = ""
TKPemasok.Text = ""
TNPemasok.Text = ""
TKeterangan.Text = ""
MseSubTotal.Text = ""
MsePotongan.Text = ""
MseTotal.Text = ""

TKBarang.Text = ""
TNBarang.Text = ""
TSatuan.Text = ""
MseHarga.Text = ""
MseJumlah.Text = ""

Total = 0

End Sub

Sub Detail()
Dim Msql As String

'Mengatur Tampilan record pada Data Grid
Msql = "Select KodeBarang, NamaBarang, HargaBeli, Jumlah, Total" & _
" From tbNotaBeliDetail Where NoNota='" & TNota.Text & "'"

Adodc1.RecordSource = Msql
Adodc1.Refresh

dgDetail.Refresh

End Sub