Belajar Membuat Form Transaksi

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