Form transaksi ini di buat dengan asumsi bahwa amda telah membuat form barang dan form user.
Dengan menggunakan konsep normalisasi bentuk terakhir sebagai berikut :
Tabel Barang Tabel Faktur Tabel User Tabel Detail Faktur
Gambar di atas merupakan normalisasi bentuk 3NF. Untuk table temporary(tmp) tidak disertakan di
dalam normalisasi.
Dan ketikkan Listing Code berikut ini : <teliti mengerjakannya yahh!!!>
Private Sub cmdbatal_Click()
bersih_awal
nonaktif
cmdtambah.Enabled = True
cmdtambah.SetFocus
cmdbatal.Enabled = False
Form_Activate
End Sub
Private Sub cmdkeluar_Click()
Unload Me
End Sub
Private Sub cmdsimpan_Click()
If txtubay.Text = " " Then
MsgBox "Pembayaran Harus Diisi", vbInformation, "Informasi"
txtubay.SetFocus
Exit Sub
End If
adotrans.Recordset.AddNew
adotrans.Recordset.Fields("nofak") = txtnofak.Text
adotrans.Recordset.Fields("tglfak") = txttgl.Text
adotrans.Recordset.Fields("Userid") = txtkode_user.Text
adotrans.Recordset.Fields("total") = txttobay.Text
adotrans.Recordset.Update
With adotmp.Recordset
.MoveFirst
n = 1
While Not adotmp.Recordset.EOF
'pengurangan jumlah stock pada data barang
adobrg.Recordset.Find "Kdbrg=' " + txtkobar.Text + " ' ", , adSearchForward, 1
If Not adobrg.Recordset.EOF Then
adobrg.Recordset.Fields("stok") = adobrg.Recordset.Fields("stok") - .Fields("qty")
adobrg.Recordset.Update
End If
With ado_detail.Recordset
.AddNew
.Fields("nofak") = adotrans.Recordset.Fields("nofak")
.Fields("Kdbrg") = adotmp.Recordset.Fields("Kdbrg")
.Fields("qty") = adotmp.Recordset.Fields("qty")
.Fields("subtotal") = adotmp.Recordset.Fields("subtotal")
.Update
End With
.MoveNext
n = n + 1
Wend
End With
MsgBox "Data Telah Tersimpan", vbOKOnly, "Pesan"
Form_Activate
bersih_awal
cmdtambah.Enabled = True
cmdtambah.SetFocus
End Sub
Private Sub cmdtambah_Click()
bersih_awal
aktif
cmdsimpan.Enabled = True
cmdtambah.Enabled = False
cmdbatal.Enabled = True
txtkode_user.SetFocus
no_baru
End Sub
Private Sub Form_Activate()
For i = 1 To adotmp.Recordset.RecordCount
adotmp.Recordset.MoveLast
adotmp.Recordset.Delete
txttobay.Text = " "
txtubay.Text = " "
txtukem.Text = " "
If adotmp.Recordset.RecordCount <= 0 Then
Exit Sub
End If
Next i
nonaktif
cmdbatal.Enabled = False
End Sub
Private Sub Form_Load()
txttgl.Text = Date
End Sub
Sub nonaktif()
txtnofak.Enabled = False
txttgl.Enabled = False
txtkobar.Enabled = False
txtnabar.Enabled = False
txtkode_user.Enabled = False
txtnama_user.Enabled = False
txtharga.Enabled = False
txtqty.Enabled = False
txtsub.Enabled = False
txttobay.Enabled = False
txtubay.Enabled = False
txtukem.Enabled = False
cmdsimpan.Enabled = False
End Sub
Sub aktif()
txtkode_user.Enabled = True
txtkobar.Enabled = True
txtubay.Enabled = True
End Sub
Sub bersih_barang()
txtkobar.Text = " "
txtnabar.Text = " "
txtharga.Text = " "
txtqty.Text = " "
txtsub.Text = " "
End Sub
Sub bersih_awal()
txtnofak.Text = " "
txtkode_user.Text = " "
txtnama_user.Text = " "
txtkobar.Text = " "
txtnabar.Text = " "
txtharga.Text = " "
txtqty.Text = " "
txtsub.Text = " "
txttobay.Text = " "
txtubay.Text = " "
txtukem.Text = " "
End Sub
Sub no_baru()
Dim nota As String
Dim notaint As Integer
nota = Format(Date, "mmyy")
With adotrans.Recordset
If .RecordCount = 0 Then
nota = nota & "0001"
Else
.MoveLast
If Format(Date, "mmyy") <> Val(Left(!nofak, 4)) Then
nota = Format(Date, "mmyy") & "0001"
Else
notaint = Val(Right(!nofak, 4)) + 1
nota = Format(Date, "mmyy") & Right("0000" & notaint, 4)
End If
End If
End With
txtnofak.Text = nota
End Sub
Private Sub txtkobar_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
adobrg.Recordset.Find "Kdbrg='" + txtkobar.Text + "'", , adSearchForward, 1
If Not adobrg.Recordset.EOF Then
txtnabar.Text = adobrg.Recordset.Fields("Nmbrg")
txtharga.Text = adobrg.Recordset.Fields("Hrgjual")
txtqty.Enabled = True
txtqty.SetFocus
Else
tanya = MsgBox("Kode Barang Tersebut Tidak Ditemukan", vbOKOnly, "Tidak ada")
If tanya = vbOK Then
txtkobar.Text = " "
txtkobar.SetFocus
End If
End If
End If
End Sub
Private Sub txtkode_user_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
adouser.Recordset.Find "Userid='" + txtkode_user.Text + "'", , adSearchForward, 1
If Not adouser.Recordset.EOF Then
txtnama_user.Text = adouser.Recordset.Fields("Nmuser")
txtkobar.SetFocus
txtkode_user.Enabled = False
Else
tanya = MsgBox("Kode User Tersebut Tidak Ditemukan", vbOKOnly, "Tidak ada")
If tanya = vbOK Then
txtkode_user.Text = ""
txtkode_user.SetFocus
End If
End If
End If
End Sub
Private Sub txtqty_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(txtqty.Text)) = 0 Then
MsgBox "Maaf anda belum mengisi jumlah beli !", vbInformation + vbOKOnly, "info"
txtqty.SetFocus
Exit Sub
End If
If Val(txtqty.Text) > adobrg.Recordset.Fields("Stok") Then
MsgBox "Barang tidak cukup..!!Lihat Data Barang..", vbInformation, "Info"
txtqty.Text = ""
Else
txtsub.Text = Val(txtharga.Text) * Val(txtqty.Text)
txtsub.Enabled = True
txtsub.SetFocus
End If
End If
End Sub
Private Sub txtsub_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
With adotmp.Recordset
.AddNew
.Fields("Kdbrg") = txtkobar.Text
.Fields("Nmbrg") = txtnabar.Text
.Fields("Hrgjual") = txtharga.Text
.Fields("Qty") = txtqty.Text
.Fields("Subtotal") = txtsub.Text
.Update
txttobay.Text = Val(txttobay.Text) + Val(txtsub.Text)
txtkobar.SetFocus
bersih_barang
no_baru
End With
End If
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
Private Sub txtubay_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtukem.Text = Val(txtubay.Text) - Val(txttobay.Text)
cmdsimpan.SetFocus
End If
End Sub
