Punya Account Blogger?
Posted by Sofyan SOX on Selasa, 18 Mei 2010 in

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
1 Response to “One 2 Many Session 2”:

Posting Komentar