Ebook | Download disini
Latihan | Download disini
One2Many -
'Assalamu'alaikum semuanya
'Yuk kita buat Form Penjualan One To Many
'Pertama buat 4 buah tabel
'tabel Barang, kasir, Jual dan sementara
'Jangan lupan koneksikan dengan data object
'nah ini dia listingnya
'1. Prosedur membersihkan isi textbox
'bersih 1 untuk tabel sementara, bersih 2 untuk tabel jual
Sub bersih1()
cbkode = ""
tnama = ""
tharga = ""
tjml = ""
tsub = ""
End Sub
Sub bersih2()
tfak = ""
cbkas = ""
tkas = ""
ttot = ""
tbay = ""
tkem = ""
bersih1
End Sub
'2. Nonaktifkan Textbox untuk Output
Sub Awal()
tfak.Enabled = 0
tkas.Enabled = 0
tnama.Enabled = 0
tharga.Enabled = 0
tsub.Enabled = 0
ttot.Enabled = 0
tkem.Enabled = 0
End Sub
'3. Mengisi Combo Kode Barang & Kode Kasir
Sub kombo()
On Error Resume Next
DKasir.Recordset.MoveFirst
Do
cbkas.AddItem DKasir.Recordset!kdkasir
DKasir.Recordset.MoveNext
Loop Until DKasir.Recordset.EOF
Dbarang.Recordset.MoveFirst
Do
cbkode.AddItem Dbarang.Recordset!kdbar
Dbarang.Recordset.MoveNext
Loop Until Dbarang.Recordset.EOF
End Sub
'4. Kondisi Ketika Form Aktif
Private Sub Form_Activate()
Awal
kombo
cbaru.SetFocus
End Sub
'5. Pencarian Data
Private Sub cbkas_Click()
DKasir.Recordset.FindFirst "kdkasir = '" & cbkas & "'"
tkas = DKasir.Recordset!nmkasir
End Sub
Private Sub cbkode_Click()
Dbarang.Recordset.FindFirst "kdbar = '" & cbkode & "'"
tnama = Dbarang.Recordset!nmbar
tharga = Dbarang.Recordset!harga
tjml.SetFocus
End Sub
'6. Menghitung Subtotal
Private Sub tjml_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tsub.Text = Val(tjml.Text) * Val(tharga.Text): ctambah.SetFocus
End Sub
'7. Penyimpanan Ke Tabel Sementara
Private Sub ctambah_Click()
With DSem.Recordset
.AddNew
!nofak = tfak
!kdbar = cbkode
!nmbar = tnama
!harga = Val(tharga)
!jml = Val(tjml)
!subtotal = Val(tsub)
.Update
bersih1
Hitung
tbay.SetFocus
End With
End Sub
'8. Menjumlahkan Subtotal dari Tabel Sementara
Sub Hitung()
Dim jum As Currency
DSem.Recordset.MoveFirst
Do
jum = jum + DSem.Recordset!subtotal
DSem.Recordset.MoveNext
Loop Until DSem.Recordset.EOF
ttot.Text = jum
End Sub
'9. Menghitung kembalian
Private Sub tbay_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
tkem = Val(tbay) - Val(ttot)
If tkem < 0 Then MsgBox "Kurang Euy": tbay = "": tkem = ""
End If
End Sub
'10. Membuat No Faktur Otomatis
Sub otomatis()
Dim no As Integer
If Djual.Recordset.RecordCount = 0 Then
tfak = "FJ001"
Else
Djual.Recordset.MoveLast
no = Val(Right(Djual.Recordset!nofak, 3)) + 1
tfak = "FJ00" & no
End If
End Sub
'11. Menyimpan Ke Tabel Jual
Private Sub cbaru_Click()
Select Case cbaru.Caption
Case "Baru": cbaru.Caption = "Simpan"
bersih2
otomatis
Case "Simpan": cbaru.Caption = "Baru"
With Djual.Recordset
.AddNew
!nofak = tfak
!tgl = ttgl
!kdkasir = cbkas
!total = Val(ttot)
!bayar = Val(tbay)
.Update
MsgBox " Teng Q, Jgn Lupa Balik Lagi"
bersih2
sapubersih
End With
End Select
End Sub
'12. Membersihkan Tabel Sementara
Sub sapubersih()
DSem.Recordset.MoveFirst
Do
DSem.Recordset.Delete
DSem.Recordset.MoveNext
Loop Until DSem.Recordset.EOF
ttot.Text = jum
End Sub
Ilham Maulana | On: 18 Mei 2010 pukul 19.28
mudah - mudahan yang ini lebih mudah