LISTING FORM TRANSAKSI (PEMROGRAMAN VISUAL 1)_LIAH HASTUTI

Silahkan desain form transaksi  berikut:

Untuk listingnya akan saya share di atasnya: 

untuk koneksi database silahkan disesuaikan.Jika DATA BARANG maka koneksikan ke database masing-masing yang sudah dibuat dan koneksikan ke tabel barang. Jika DATA CUSTOMER maka koneksikan ke database masing-masing yang sudah dibuat dan koneksikan ke tabel customer, dan seterusnya. Dan untuk DBGridnya menggunakan data_sementara. Selamat belajar :)


Dim indeks As Byte
Dim KDbarang(8) As String
Dim JMLbarang(8) As Byte

Sub nomor()
Dim urutan As String
Dim hitung As Integer
data_transaksi.Refresh
With data_transaksi.Recordset
If .RecordCount = 0 Then
urutan = "FAKTUR" & Format(Date, "YY") & Format(Date, "mm") & "001"
tno_faktur.Text = urutan
Else
.MoveLast
hitung = Val(Right(!nomor_faktur, 3)) + 1
urutan = "FAKTUR" & Format(Date, "YY") & Format(Date, "mm") & Right("000" & hitung, 3)
tno_faktur.Text = urutan
End If
End With
End Sub

Private Sub add_Click()
Call nomor
aktif
DBcustomer.SetFocus
save.Enabled = True
cancel.Enabled = True
add.Enabled = False
End Sub

Private Sub cancel_Click()
With sementara.Recordset
Data_barang.Recordset.Index = "kode_barang"
For I = 1 To indeks
Data_barang.Recordset.Seek "=", KDbarang(I)
Data_barang.Recordset.edit
Data_barang.Recordset!stok = Data_barang.Recordset!stok + JMLbarang(I)
Data_barang.Recordset.Update
Next I
Data_barang.Refresh
End With
Form_Activate
sementara.Refresh
Data_barang.Refresh
End Sub

Function hapus_grid()
'menghapus untuk tabel sementara
If sementara.Recordset.RecordCount = 0 Then
nonaktif
Else
sementara.Recordset.MoveFirst
Do While Not sementara.Recordset.EOF
sementara.Recordset.Delete
sementara.Recordset.MoveNext
Loop
End If
End Function

Private Sub DBbarang_Click(Area As Integer)
Data_barang.Recordset.Index = "kode_barang"
Data_barang.Recordset.Seek "=", DBbarang
If Not Data_barang.Recordset.NoMatch Then
tnama_barang.Text = Data_barang.Recordset!nama_barang
tnama_barang.Enabled = False
tharga.Text = Data_barang.Recordset!harga_barang
tharga.Enabled = False
tqty.SetFocus
End If
End Sub

Private Sub DBcustomer_Click(Area As Integer)
Data_customer.Recordset.Index = "kode_customer"
Data_customer.Recordset.Seek "=", DBcustomer
If Not Data_customer.Recordset.NoMatch Then
tnama_customer.Text = Data_customer.Recordset!nama_customer
End If
End Sub

Private Sub Form_Activate()
nonaktif
bersih
add.Enabled = True
save.Enabled = False
cancel.Enabled = False
keluar.Enabled = True
hapus_grid
End Sub

Sub bersih()
For Each x In Me
If TypeName(x) = "TextBox" Then x.Text = ""
DBbarang = ""
DBcustomer = ""
Next x
End Sub

Private Sub Form_Unload(cancel As Integer)
Dim keluar As String
keluar = MsgBox("Anda akan keluar sistem?", _
vbQuestion + vbYesNo, "Message")
Select Case keluar
Case vbYes
End
Case Else: cancel = 1: End Select
End Sub

Private Sub hapus_Click()
data_transaksi.Recordset.Delete
data_transaksi.Recordset.MoveFirst
add.Enabled = True
End Sub

Private Sub keluar_Click()
a = MsgBox("Anda Yakin Akan keluar?", vbYesNo, "INFO")
If a = vbYes Then
form_transaksi.Visible = False
F_MENU.Show
End If
End Sub

Private Sub save_Click()
'simpan ke tabel transaksi
data_transaksi.Recordset.AddNew
data_transaksi.Recordset!nomor_faktur = tno_faktur.Text
data_transaksi.Recordset!tgl_faktur = ttgl_faktur
data_transaksi.Recordset!kode_customer = DBcustomer
data_transaksi.Recordset!total_bayar = tjumlah_bayar.Text
data_transaksi.Recordset.Update

'simpan ke tabel detail
With sementara.Recordset
.MoveFirst
While Not sementara.Recordset.EOF
'With detail.Recordset
detail.Recordset.AddNew
detail.Recordset!nomor_faktur = !nomor_faktur
detail.Recordset!kode_barang = !kode_barang
detail.Recordset!qty = !qty
detail.Recordset!subtotal = !subtotal
detail.Recordset.Update
.Delete
.MoveNext
Wend
End With
sementara.Refresh
detail.Refresh
form_transaksi.Refresh
MsgBox "Data telah tersimpan", vbOKOnly, "Informasi"
Form_Activate
End Sub

Sub aktif()
For Each x In Me
If TypeName(x) = "TextBox" Then x.Enabled = True
DBbarang.Enabled = True
DBcustomer.Enabled = True
Next x
End Sub

Sub nonaktif()
For Each x In Me
If TypeName(x) = "TextBox" Then x.Enabled = False
DBbarang.Enabled = False
DBcustomer.Enabled = False
Next x
End Sub

Private Sub Timer1_Timer()
ttgl_faktur.Text = Date
jam.Caption = Time
End Sub

Private Sub tjumlah_bayar_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If Val(tjumlah_bayar.Text) < Val(ttotal_bayar.Text) Then
    MsgBox "Uang Kurang"
    tjumlah_bayar.Text = ""
    tjumlah_bayar.SetFocus
    Else
    ttotal_kembali.Text = Val(tjumlah_bayar.Text) - Val(ttotal_bayar.Text)
    ttotal_kembali.Enabled = False
    End If
    save.SetFocus
End If
End Sub

Private Sub tqty_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
'pengecekan stok
Data_barang.Recordset.Index = "kode_barang"
Data_barang.Recordset.Seek "=", Me.DBbarang.Text
If Not Data_barang.Recordset.NoMatch Then
If Data_barang.Recordset!stok < Val(Me.tqty.Text) Or tqty = "" Or tqty.Text = "0" Then
MsgBox "stok tidak mencukupi!", vbExclamation, "pesan"
tqtyText = ""
tqty.SetFocus
Else
'perulangan pada grid
Let indeks = indeks + 1
Let KDbarang(indeks) = DBbarang.Text
Let JMLbarang(indeks) = Val(tqty.Text)

'pengurangan stok pada table barang
Data_barang.Recordset.edit
Data_barang.Recordset!stok = Val(Data_barang.Recordset!stok) - Val(tqty.Text)
Data_barang.Recordset.Update
    tsubtotal.Text = Val(tqty.Text) * Val(tharga.Text)
    tsubtotal.Enabled = False
  'simpan data ke table sementara
    sementara.Recordset.AddNew
    sementara.Recordset!nomor_faktur = tno_faktur.Text
    sementara.Recordset!kode_barang = DBbarang.Text
    sementara.Recordset!nama_barang = tnama_barang.Text
    sementara.Recordset!harga = tharga.Text
    sementara.Recordset!qty = tqty.Text
    sementara.Recordset!subtotal = tsubtotal.Text
    sementara.Recordset.Update

   'perulangan lebih dari satu transaksi
    a = MsgBox("Ingin Beli Lagi,,,", vbQuestion + vbYesNo, "Konfirmasi")
    ttotal_bayar.Text = Val(ttotal_bayar.Text) + Val(tsubtotal.Text)
    ttotal_bayar.Enabled = False
            If a = vbYes Then
                DBbarang.Text = ""
                DBbarang.SetFocus
                tnama_barang.Text = ""
                tqty.Text = ""
                tharga.Text = ""
                tqty.Text = ""
                tsubtotal.Text = ""
            Else
  
'jika transaksi selesai
                MsgBox "Selesai"
                DBbarang.Enabled = False
                tqty.Enabled = False
                tjumlah_bayar.SetFocus
            End If
 End If
 End If
End If
sementara.Refresh
End Sub