Membuat "Form Transaksi Pembelian Barang"

Pembuatan Form Transaksi Pembelian Barang

Pembahasan ini merupakan kelanjutan dari pokok bahasan "Aplikasi Inventory dan Lapoan Keuangan VB 6.0", baca terlebih dahulu pokok bahasan tersebut agar lebih jelas.

Melanjutkan Tutorial yang berikutnya kita akan membahas mengenai pembuatan Form Transaksi Pembelian Barang dalam Aplikasi Inventory dan Laporan Keuangan. Pada form transaksi pembelian yang akan Kita bahas disini akan langsung terkait dengan proses pembukuan keuangan yaitu jurnal umum. Pada praktek di lapangan sekarang ini perusahaan-perusahaan perdagangan yang sudah besar masih menggunakan pencatatan manual belum terkomputerisasi dengan baik, sehingga seringkali terjadi kesalahan-kesalahan dalam melakukan pelaporan keuangan.

Hal-hal seperti itu yang perlu dibenahi pada suatu perusahaan perdagangan, sehingga perputaran keuangan perusahaan dapat dipantau dengan baik dan tersistem. Nah di pembahasan ini sekalilagi saya ulangi, untuk proses pencatat Transaksi Pembelian Barang yaitu nilai nominal total pembelian barang akan tercatat secara langsung ke dalam data jurnal umum. Sebagai contoh kasus seperti di bawah ini:

Pada Tanggal 10 Januari 2017 Toko melakukan penamambahan stok barang dari pembelian barang berupa; a. Beras dengan berat 10 KG/SAK sebanyak 5 SAK harga tiap SAK (10 KG) Rp. 25.000,-; b. Gula Pasir dengan berat 10 KG/SAK sebanyak 10 SAK harga tiap SAK (10 KG) Rp. 35.000,-.

Dari contoh kasus tersebut di atas apabila kita lakukan pencatatan secara manual, maka membutuhkan waktu proses yang lumayan lama. Data Faktur penerimaan barang dari supplier pertama dicatat dahulu ke bagian gudang untuk dimasukkan ke dalam buku stock barang, selanjutnya faktur yang dari gudang kemudian diserahkan ke bagian keuangan untuk dimasukkan atau dicatat pengeluaran uang ke pembukuan akuntansi.

Akantetapi apabila menggunakan aplikasi terkomputerisasi dengan baik dan terstruktur, maka proses laporan keuangan akan lebih cepat dan lebih mudah karena bagian keuangan tidak perlu mencatat ke buku jurnal lagi karena sudah langsung tercatat ke buku jurnal saat melakukan pencatatan faktur penerimaan barang. Jadi tugas bagian keuangan akan lebih ringan hanya tinggal memposting dari jurnal umum ke buku besar.

Desain Form Transaksi Pembelian

Seperti pada pembahasan sebelumnya yaitu "Membuat Form Barang Aplikasi Inventory VB 6.0", untuk membuat desain Form Transaksi Pembelian cara dan langkah-langkahnya sama yaitu kita tambahkan Form Baru ke dalam project melalui menu Project ⇛ Add Form. Kemudian Anda pilih Form dan kemudian Anda klik Open.

Selanjutnya Anda simpan kembali project Anda dan simpan Form tersebut dengan nama Frm_TranBeli.frm. Berikutnya silahkan buat desain form pembelian tersebut seperti gambar berikut ini.

Objek kontrol yang dibutuhkan diantaranya:

• Frame
• Adodc
• Label 
• TextBox
• OptionButton
• DTPicker
• ComboBox
• DataGrid
• Command Button

Aturlah properties objek kontrol pada form pembelian caranya sama seperti pengaturan properties form master barang.

Selanjutnya Anda tuliskan kode programnya di bawah ini.

Dim cb As String
Dim jmlh As Currency
Dim baris As Integer
Private Sub cbo_kodepsk_LostFocus()
    On Error GoTo salah
    If txt_NoNota.Text = "" Then
        MsgBox "No Nota Kosong"
        ElseIf txt_NoNota.Text <> "" Then
        Call sambung
        sql = "Insert into PEMBELIAN Values('" & txt_NoNota & "','" & Format(DTP_TglBeli, "yyyy/mm/dd") & "','" & Cbo_KodePsk & "','" & cb & "','" & Format(DTP_JthTempo, "yyyy/mm/dd") & "'," & Val(Txt_Discont) & "," & Val(Txt_UangMuka) & "," & Val(txt_JmlHutang) & ")"
        Conn.Execute (sql)
        Cbo_KodePsk.Enabled = False
    End If
    Cmd_Tambah.Enabled = False
    Exit Sub
salah:
    Select Case Err.Number
    Case -2147217900
        errmsg = " Maaf No Nota " & txt_NoNota & " Sudah Ada" & vbCrLf
    Case -2147217833
        errmsg = " Maaf Silahkan Pilih Kode Pemasok" & vbCrLf
    Case Else
        errmsg = Err.Description
    End Select
    MsgBox errmsg, vbCritical + vbOKOnly, "Informasi:"
End Sub
Private Sub cmd_cetak_Click()
    CR_BELI.ReportFileName = App.Path & "\REPORT\Lap BELI2.rpt"
    CR_BELI.SelectionFormula = "{pembelian.nonotabeli} = '" & Cbo_NoNota & "'"
    CR_BELI.RetrieveDataFiles
    CR_BELI.Action = 2
    CR_BELI.WindowState = crptMaximized
End Sub
Private Sub cmd_Tambah_Click()
    Call NoUrutOtomatisUntukJurnal
    txt_NoNota.Enabled = True
    txt_NoNota.SetFocus
    DTP_JthTempo.Enabled = False
    Cmd_Tambah.Enabled = False
    Cmd_Batal.Enabled = False
    Call Kosong
    DTP_TglBeli.Enabled = False
End Sub

Private Sub cmd_tutup_Click()
    Dim pesan As String
    pesan = MsgBox("Apakah Anda Yakin Mau Mengakhiri ?", vbYesNo + vbCritical, "Konfirmasi")
    If pesan = vbYes Then Unload Me

End Sub

Private Sub DataGridCariBrg_Keypress(keyascii As Integer)
    'mengambil data kode brg dari grid
    If keyascii = 13 Then
        FrameCari.Top = -15000
        Cbo_KodeBrg.Text = DataGridCariBrg.Columns(0).Text
    End If
    Txt_qty.SetFocus
    Call sambung
    sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg & "'"
    Set rs = Conn.Execute(sql)
    If Not rs.EOF Then
        Txt_NamaBrg = rs("namaBarang") + "  " + rs("ukuran")
        Txt_Ukuran = rs("ukuran")
        Txt_StockBrg = rs("stockawal")
        Txt_Satuan = rs("Satuan")
    End If
    Txt_qty.Enabled = True
End Sub
Private Sub DataGridCariBrg_dblclick()
    'mengambil data kode brg dari grid
    Cbo_KodeBrg.Text = DataGridCariBrg.Columns(0).Text
    Call sambung
    sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg & "'"
    Set rs = Conn.Execute(sql)
    If Not rs.EOF Then
        Txt_NamaBrg = rs("namaBarang") + "  " + rs("ukuran")
        Txt_Ukuran = rs("ukuran")
        Txt_StockBrg = rs("stockawal")
        Txt_Satuan = rs("Satuan")
    End If
    Txt_qty.Enabled = True
    Txt_qty.SetFocus
End Sub

Private Sub DTP_TglBeli_click()
    Opt_Kredit.Enabled = True
    Opt_Tunai.Enabled = True
    Cbo_KodePsk.Enabled = True
End Sub
Private Sub DTP_TglBeli_lostfocus()
    Opt_Kredit.Enabled = True
    Opt_Tunai.Enabled = True
    Cbo_KodePsk.Enabled = True
    'Opt_Tunai.SetFocus
End Sub

Private Sub Form_Activate()
    'Ukuran dan posisi form
    Me.Top = 50
    Me.Left = 800

End Sub
Private Sub Cbo_KodeBrg_Click()
    Call sambung
    sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg & "'"
    Set rs = Conn.Execute(sql)
    If Not rs.EOF Then
        Txt_NamaBrg = rs("namaBarang") + "  " + rs("ukuran")
        Txt_Ukuran = rs("ukuran")
        Txt_StockBrg = rs("stockawal")
        Txt_Satuan = rs("Satuan")
        txt_HrgJual = Format("0" & rs("hargaJualBarang"), "Rp #,##0")
    End If
    Txt_qty.Enabled = True
    Txt_harga.Enabled = True
End Sub
Private Sub Cbo_KodeBrg_lostfocus()
    Call sambung
    sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg & "'"
    Set rs = Conn.Execute(sql)
    If Not rs.EOF Then
        Txt_NamaBrg = rs("namaBarang") + "  " + rs("ukuran")
        Txt_Ukuran = rs("ukuran")
        Txt_StockBrg = rs("stockawal")
        Txt_Satuan = rs("Satuan")
    End If
    '------------------------------------
    Dim StockAwl As Long
    Dim StockMn As Long
    Dim stockMx As Long
    Call sambung
    sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg.Text & "'"
    Set rs = Conn.Execute(sql)
    If Not rs.EOF Then
        StockAwl = rs("stockAwal")
        StockMn = rs("stockMin")
        stockMx = rs("stockMax")
        If StockAwl >= stockMx Then
            MsgBox " Jumlah Stock Penuh Atau Melebihi Stock Max " + Chr(13) + " Silahkan Membeli Barang Lain", vbCritical
            Txt_qty = ""
            Txt_harga = ""
            Cbo_KodeBrg.SetFocus
        ElseIf StockAwl <= StockMn Then
            MsgBox "Jumlah Stock Kurang Dari Stock Min " + Chr(13) + "Silahkan Melakukan Pembelian", vbInformation
        End If
    End If
End Sub
Private Sub Cbo_KodePsk_Click()
If Opt_Tunai.Value = True Then
cb = "TUNAI"
Else
cb = "KREDIT"
End If
Call sambung
sql = "select * from pemasok where kd_pemasok='" & Cbo_KodePsk & "'"
Set rs = Conn.Execute(sql)
If Not rs.EOF Then
Txt_NamaPsk = rs("namapemasok")
End If
txt_NoNota.Enabled = False
Cbo_KodeBrg.Enabled = True
Cmd_Cari.Enabled = True
End Sub
Private Sub Form_Load()
Call Kosong
Call TidakTampak
Cmd_Batal.Enabled = False
Cmd_Simpan.Enabled = False
Call sambung
ADO_DBELI.RecordSource = "SELECT * FROM DETAIL_PEMBELIAN WHERE NONOTABELI=KD_BARANG"
Set DataGrid1.DataSource = ADO_DBELI
'menampilkan kode pemasok+nama
Call sambung
Ado_beli.RecordSource = "select * from Pemasok"
Ado_beli.Refresh
Cbo_KodePsk.Clear
Do While Not Ado_beli.Recordset.EOF
Cbo_KodePsk.AddItem Ado_beli.Recordset.Fields("KD_pemasok")
Ado_beli.Recordset.MoveNext
Loop
Cbo_KodePsk.Text = "Pilih Pemasok"
'---------------------------
'menampilkan kode barang
Ado_beli.RecordSource = "select * from Barang"
Ado_beli.Refresh
Cbo_KodeBrg.Clear
Do While Not Ado_beli.Recordset.EOF
Cbo_KodeBrg.AddItem Ado_beli.Recordset.Fields("Kd_Barang")
Ado_beli.Recordset.MoveNext
Loop
Cbo_KodeBrg.Text = "Pilih Barang"
'---------------------------
'Menformat tanggal
DTP_TglBeli.Value = Format(Now, "dd/mm/yyyy")
DTP_JthTempo.Value = Format(Now, "dd/mm/yyyy")
'----------------------------
Call sambung
ADO_NONOTA.RecordSource = "select * from pembelian"
ADO_NONOTA.Refresh
Cbo_NoNota.Clear
Do While Not ADO_NONOTA.Recordset.EOF
Cbo_NoNota.AddItem ADO_NONOTA.Recordset.Fields("NoNotaBeli")
ADO_NONOTA.Recordset.MoveNext
Loop
Cbo_NoNota.Text = "Cetak"
End Sub
Private Sub Cbo_nonota_keypress(keyascii As Integer)
 keyascii = AutoComplete(Cbo_NoNota, keyascii, False, Asli)
End Sub

Private Sub Opt_Kredit_click()
DTP_JthTempo.Enabled = True
Cbo_KodePsk.Enabled = True
End Sub

Private Sub Opt_Tunai_click()
DTP_JthTempo.Enabled = False
End Sub
Private Sub Txt_Bayar_Change()
txt_jmlHtg.Text = Format((CCur("0" & Txt_Gtotal.Text) - CCur("0" & Txt_UangMuka.Text)) - CCur("0" & Txt_Bayar.Text), "#,##0")
End Sub
Private Sub Txt_Bayar_lostfocus()
If CCur("0" & Txt_Bayar.Text) > (CCur("0" & Txt_Gtotal.Text) - CCur("0" & Txt_UangMuka.Text)) Then
MsgBox "Sisa Bayar Terlalu Besar"
Txt_Bayar.SetFocus
Txt_Bayar = 0
Else:
SendKeys vbEnter
End If
Txt_Bayar.Text = Format("0" & Txt_Bayar.Text, "#,##0")
End Sub
Private Sub Txt_Discont_change()
Txt_Gtotal.Text = Format(CCur("0" & Txt_total.Text) - CCur("0" & Txt_Discont.Text), "#,##0")
Txt_UangMuka.Enabled = True
End Sub
Private Sub Txt_Discont_lostfocus()
Txt_Discont.Text = Format("0" & Txt_Discont.Text, "#,##0")
If CCur("0" & Txt_Discont.Text) > CCur("0" & Txt_total.Text) Then
MsgBox "Discont Terlalu Besar" Txt_Discont.SetFocus
Txt_Discont = 0
Else:
SendKeys vbEnter
End If
Txt_UangMuka.SetFocus
End Sub

Private Sub txt_harga_KeyPress(keyascii As Integer)
Dim grandtotal As Long
Dim StockAwl As Long
Dim StockMn As Long
Dim stockMx As Long
Dim hrgjual As Currency
'On Error GoTo salah
'Menghindari Penginputan Selain Angka
If Not (keyascii >= Asc("0") & Chr(13) _
     And keyascii <= Asc("9") & Chr(13) _
     Or keyascii = vbKeyBack _
     Or keyascii = vbKeyDelete) And Not (keyascii = 13) Then
        Beep
        keyascii = 0
        MsgBox "   Data Harus Angka"
 ElseIf keyascii = 46 Then
 keyascii = 0
 MsgBox "   Data Harus Angka "
ElseIf keyascii = 13 Then
'SendKeys vbTab
End If
'--------------------------------------
'Menyimpan Ke Tabel Detail_Pembelian
Call sambung
sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg.Text & "'"
Set rs = Conn.Execute(sql)
Call sambung
sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg.Text & "'"
Set rs = Conn.Execute(sql)
If Not rs.EOF Then
StockAwl = rs("stockAwal")
StockMn = rs("stockMin")
stockMx = rs("stockMax")
hrgjual = rs("hargajualBarang")
End If
If Val(Txt_harga.Text) > hrgjual Then
MsgBox "Harga Beli Lebih Besar Harga Jual" + Chr(13) + "Jika Ingin Membeli Silahkan Ubah Harga Jual Terlebih Dahulu", vbCritical, "Warning"
ElseIf (Val(Txt_qty.Text) > 0 And Val(Txt_harga.Text) > 0) And Val(Txt_qty.Text) + StockAwl <= stockMx And StockAwl < stockMx And Val(Txt_harga.Text) <= hrgjual And keyascii = 13# Then
Call sambung
'sql = "Insert into Detail_pembelian" & _
        " Values('" & txt_NoNota.Text & "','" & Cbo_KodeBrg.Text & "', " & _
        " " & Val(Txt_harga.Text) & "," & _
        " " & Val(Txt_qty.Text) & ")"
Conn.Execute "Insert into Detail_pembelian(NoNotaBeli,Kd_Barang,HargaBeliBarang,jumlahBarang)" & _
        " Values('" & txt_NoNota.Text & "','" & Cbo_KodeBrg.Text & "', " & _
        " " & Val(Txt_harga.Text) & "," & _
        " " & Val(Txt_qty.Text) & ")"
Txt_harga.Text = ""
Txt_qty.Text = ""
ADO_DBELI.Refresh
Ado_beli.Recordset.MoveLast
Cbo_KodeBrg.SetFocus
If Val(Txt_qty.Text) + StockAwl > stockMx Then
MsgBox " Jumlah Barang Melebihi Stock Max"
Txt_qty.SetFocus
End If
End If
Call sambung
ADO_DBELI.ConnectionString = Connect
ADO_DBELI.RecordSource = "SELECT D.KD_Barang AS KODE,B.NAMABarang + ' ' + B.ukuran AS [NAMA BRG], D.JUMLAHBARANG AS QTY,D.HARGABELIBarang AS [HARGA BELI], " & _
" D.JUMLAHBARANG * D.HARGABELIBarang AS JUMLAH FROM DETAIL_PEMBELIAN D,Barang B Where D.KD_Barang = B.KD_Barang AND D.NONOTABELI = '" & txt_NoNota & "'"
ADO_DBELI.Refresh
    If ADO_DBELI.Recordset.RecordCount = 0 Then
        Txt_Gtotal.Text = "0"
Else
        sql = "SELECT SUM(JUMLAHBARANG * HARGABELIBarang)  AS Jumlah FROM Detail_Pembelian WHERE Nonotabeli ='" & txt_NoNota & "'"
        Set rs = Conn.Execute(sql)
        Txt_total.Text = Format(CCur("0" & rs("Jumlah")), "#,##0")
End If
ADO_DBELI.Refresh

Lbl_JmlBeli.Caption = "Jumlah Data : " & ADO_DBELI.Recordset.RecordCount
Txt_Discont.Enabled = True
Cmd_Batal.Enabled = True
Cmd_Simpan.Enabled = True
txt_NoNota.Enabled = False
'-----------CboCetak=TxtNoNota-----------
Cbo_NoNota.Text = txt_NoNota.Text
'----------------------------------------
Exit Sub
salah:
Select Case Err.Number
Case -2147217900
errmsg = " Maaf Kode Barang " & Cbo_KodeBrg.Text & "Sudah Ada" + Chr(13) + "Jika Ingin Merubah Bisa Menghapusnya" & vbCrLf
Case -2147217833
errmsg = " Maaf Silahkan Pilih Kode Barang" & vbCrLf
Cbo_KodeBrg.SetFocus
Case Else
errmsg = Err.Description
End Select
MsgBox errmsg, vbCritical + vbOKOnly, "Informasi:"
End Sub
Private Sub cmd_Simpan_Click()
Dim pesan As String
Dim TambahStock As Integer
On Error Resume Next
'--validasi cara bayar---------
If CCur(txt_jmlHtg.Text) > 0 And Opt_Tunai.Value = True Then
MsgBox "Silahkan Ubah Cara Bayar", vbCritical, "Cara Bayar"
ElseIf CCur(txt_jmlHtg.Text) = 0 And Opt_Kredit.Value = True Then
MsgBox "Silahkan Ubah Cara Bayar", vbCritical, "Cara Bayar"
Else: 'menyimpan
pesan = MsgBox(" Apakah Anda Mau Menyimpan ?", vbYesNo + vbInformation, "Konfirmasi")
    If pesan = vbYes Then
If Opt_Tunai.Value = True Then
cb = "TUNAI"
Else
cb = "KREDIT"
End If
Call sambung
sql = "Update PEMBELIAN Set Tanggal='" & Format(DTP_TglBeli, "yyyy/mm/dd") & "',Kd_Pemasok='" & Cbo_KodePsk & "',CaraBayar='" & cb & "',JthTempo='" & Format(DTP_JthTempo, "yyyy/mm/dd") & "',DiscontBeli=" & CCur("0" & Txt_Discont.Text) & ", UangMuka=" & CCur("0" & Txt_UangMuka.Text) & ",JmlHutang=" & CCur("0" & txt_jmlHtg.Text) & "  where NoNotaBeli='" & txt_NoNota.Text & "'"
Conn.Execute (sql)
'Menyimpan Kejurnal
sql = "insert into Jurnal values ('" & txt_nojurnal & "','" & Format(DTP_TglBeli, "yyyy/mm/dd") & "','" & txt_NoNota & "','Pembelian Barang ' + ' " & cb & " ' + ' " & Txt_NamaPsk & " ' )"
Conn.Execute (sql)
If Opt_Tunai.Value = True Then
sql = "insert detailJurnal values ('" & txt_nojurnal & "','511001'," & CCur("0" & Txt_Gtotal) & ",0)"
Conn.Execute (sql)
sql = "insert detailJurnal values ('" & txt_nojurnal & "','111001',0," & CCur("0" & Txt_Gtotal) & ")"
Conn.Execute (sql)
ElseIf Opt_Kredit.Value = True Then
sql = "insert detailJurnal values ('" & txt_nojurnal & "','511001'," & CCur("0" & Txt_Gtotal) & ",0)"
Conn.Execute (sql)
sql = "insert detailJurnal values ('" & txt_nojurnal & "','111001',0," & CCur("0" & Txt_Bayar) & " + " & CCur("0" & Txt_UangMuka) & " )"
Conn.Execute (sql)
sql = "insert detailJurnal values ('" & txt_nojurnal & "','211001',0," & CCur("0" & txt_jmlHtg) & ")"
Conn.Execute (sql)
End If

Dim rsDetail_Pembelian As New ADODB.Recordset

rsDetail_Pembelian.ActiveConnection = Connect
rsDetail_Pembelian.CursorLocation = adUseClient
rsDetail_Pembelian.LockType = adLockOptimistic
rsDetail_Pembelian.CursorType = adOpenKeyset
rsDetail_Pembelian.Open "SELECT * FROM DETAIL_PEMBELIAN WHERE NoNotaBeli='" & txt_NoNota.Text & "'"

If rsDetail_Pembelian.EOF = False Then
  rsDetail_Pembelian.MoveFirst
  Do Until rsDetail_Pembelian.EOF
    sql = "Update Barang set stockawal = stockawal + " & rsDetail_Pembelian!jumlahBarang & " WHERE Kd_Barang='" & rsDetail_Pembelian!Kd_Barang & "'"
    Conn.Execute (sql)
    rsDetail_Pembelian.MoveNext
  Loop
End If
MsgBox "Berhasil Disimpan", vbInformation

End If

Cbo_KodePsk.Text = "Pilih Pemasok"
Txt_NamaPsk.Text = ""
Txt_total.Text = ""
Txt_Discont.Text = ""
Txt_Gtotal.Text = ""
Txt_StockBrg.Text = ""
Txt_UangMuka.Text = ""
Txt_Satuan.Text = ""
Cbo_KodeBrg.Text = "Pilih Barang"
Txt_NamaBrg.Text = ""
Txt_harga.Text = ""
Txt_qty.Text = ""
Txt_Bayar.Text = ""
txt_jmlHtg.Text = ""
Call TidakTampak
Cmd_Batal.Enabled = False
Cmd_Simpan.Enabled = False
ADO_DBELI.ConnectionString = Connect
ADO_DBELI.RecordSource = "SELECT D.KD_Barang AS KODE,B.NAMABarang + ' ' + B.ukuran AS [NAMA BRG], D.JUMLAHBARANG AS QTY,D.HARGABELIBarang AS [HARGA BELI], " & _
" D.JUMLAHBARANG * D.HARGABELIBarang AS JUMLAH FROM DETAIL_PEMBELIAN D,Barang B Where D.KD_Barang = B.KD_Barang AND D.NONOTABELI = '0'"
ADO_DBELI.Refresh

DTP_TglBeli.Enabled = False
Opt_Tunai.Value = True
Cmd_Tambah.Enabled = True
End If
End Sub
Private Sub Cmd_Cari_click()
FrameCari.Visible = True
FrameCari.Top = 2400
DataGridCariBrg.SetFocus
End Sub
Private Sub Cmd_Close_click()
FrameCari.Visible = False
End Sub
Private Sub t_cari_Change()
On Error GoTo SalahCari
If Cbo_cari.ListIndex = 0 Or Cbo_cari.Text = "Nama Barang" Then
AdoBrg.RecordSource = "select * from Barang where namaBarang like '%" & t_cari.Text & "%'"
AdoBrg.Refresh
ElseIf Cbo_cari.ListIndex = 1 Then
AdoBrg.RecordSource = "select * from Barang where ukuran like '%" & t_cari.Text & "%'"
AdoBrg.Refresh
ElseIf Cbo_cari.ListIndex = 2 Then
AdoBrg.RecordSource = "select * from Barang where Satuan like '%" & t_cari.Text & "%'"
AdoBrg.Refresh
ElseIf Cbo_cari.ListIndex = 3 Then
AdoBrg.RecordSource = "select * from Barang where stockawal like '%" & Val(t_cari.Text) & "%'"
AdoBrg.Refresh

Exit Sub
SalahCari:
  MsgBox "Error : " & Err & " " & Err.Description
  End If
Call sambung
AdoBrg.Refresh
L_count = "Jml Data : " & AdoBrg.Recordset.RecordCount
AdoBrg.Refresh
End Sub

Private Sub t_cari_keypress(keyascii As Integer)
Dim sTemplate As String
sTemplate = "`~@#$%^&*()+|=\<,>?/;:'"""
If Cbo_cari.ListIndex = 3 Then
If (Not (keyascii >= Asc("0") & Chr(13) _
     And keyascii <= Asc("9") & Chr(13) _
     Or keyascii = vbKeyBack _
     Or keyascii = vbKeyDelete)) Then
        Beep
        keyascii = 0
        MsgBox "Data Harus Angka"
 ElseIf keyascii = 46 Then
 keyascii = 0
 MsgBox "Data Harus Angka"
End If
End If

If InStr(1, sTemplate, Chr(keyascii)) > 0 Then _
   keyascii = 0
   keyascii = Asc(UCase(Chr(keyascii)))

End Sub
Private Sub Cmd_Batal_Click()
Dim pesan As String
    AdoBrg.Refresh
   
     'Mengembalikan Stock Barang
'''     sql = " Update Barang set stockawal = " & _
'''     " stockawal -  jumlahbarang  from Barang B, " & _
'''     " detail_pembelian D where B.kd_Barang=D.kd_Barang " & _
'''     " and d.nonotabeli= '" & txt_NoNota & "'"
'''    Conn.Execute (sql)
   
      'Menghapus record pada tabel DetailPembelian
    sql = "Delete From detail_pembelian " & _
         " Where NoNotaBeli='" & txt_NoNota.Text & "'"
    Conn.Execute (sql)
           
     'Menghapus record pada tabel Pembelian
    sql = "Delete From pembelian " & _
         " Where NoNotaBeli='" & txt_NoNota.Text & "'"
    Conn.Execute (sql)

   
    Call TidakTampak
    Call Kosong
   
    Cmd_Batal.Enabled = True
    Cmd_Simpan.Enabled = False
    Cmd_Tambah.Enabled = True
    ADO_DBELI.Refresh
   
End Sub


Sub TidakTampak()
    DTP_TglBeli.Enabled = False
    txt_NoNota.Enabled = False
    Cbo_KodePsk.Enabled = False
    Txt_NamaPsk.Enabled = False
    Opt_Tunai.Enabled = False
    Cbo_KodeBrg.Enabled = False
    Txt_NamaBrg.Enabled = False
    Txt_qty.Enabled = False
    Txt_harga.Enabled = False
    Txt_total.Enabled = False
    Txt_Discont.Enabled = False
    Txt_Gtotal.Enabled = False
    txt_jmlHtg.Enabled = False
    Txt_UangMuka.Enabled = False
    Txt_Bayar.Enabled = False
    Opt_Kredit.Enabled = False
    Opt_Tunai.Enabled = False
    Cmd_Cari.Enabled = False
End Sub
Sub Kosong()
'Mengosongkan textbox dan masked edit
txt_NoNota.Text = ""
Cbo_KodePsk.Text = "Pilih Pemasok"
Txt_NamaPsk.Text = ""
Txt_total.Text = ""
Txt_Discont.Text = ""
Txt_Gtotal.Text = ""
Txt_StockBrg.Text = ""
Txt_UangMuka.Text = ""
Txt_Satuan.Text = ""
Cbo_KodeBrg.Text = "Pilih Barang"
Txt_NamaBrg.Text = ""
Txt_harga.Text = ""
Txt_qty.Text = ""
Txt_Bayar.Text = ""
txt_jmlHtg.Text = ""
End Sub

Private Sub DataGrid1_dblclick()
Dim konsfirmasi As String
On Error GoTo salah

Cbo_KodeBrg.Text = DataGrid1.Columns(0).Text
Call sambung
sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg & "'"
Set rs = Conn.Execute(sql)
If Not rs.EOF Then
Txt_NamaBrg = rs("namaBarang") + "  " + rs("ukuran")
Txt_Ukuran = rs("ukuran")
Txt_StockBrg = rs("stockawal")
Txt_Satuan = rs("Satuan")
End If

Cbo_KodeBrg.Text = DataGrid1.Columns(0).Text
Call sambung
sql = "select * from detail_pembelian where kd_Barang='" & Cbo_KodeBrg & "' and nonotabeli = '" & txt_NoNota & " ' "
Set rs = Conn.Execute(sql)
If Not rs.EOF Then
Txt_qty = rs("jumlahbarang")
Txt_harga = rs("hargabeliBarang")
End If

konfirmasi = MsgBox("Apakah Anda Mau Menghapus Record ?", vbYesNo + vbCritical, "Konfirmasi")
    If konfirmasi = vbYes Then

    Call sambung
     sql = " Update Barang set stockawal = " & _
     " stockawal - " & Txt_qty & " where kd_Barang= '" & Cbo_KodeBrg.Text & " ' "

    Conn.Execute (sql)
    ADO_DBELI.Recordset.Delete adAffectCurrent
    ADO_DBELI.Refresh
    End If
     Exit Sub
salah:
Select Case Err.Number
Case -2147217900
errmsg = " Barang Sudah Terhapus" & vbCrLf
Case -2147217873
errmsg = " Barang Sudah Terhapus" & vbCrLf
Case 3021
errmsg = " Tidak Ada Barang Untuk DiHapus" & vbCrLf
End Select
MsgBox errmsg, vbInformation + vbOKOnly, "Informasi:"
ADO_DBELI.Refresh
Lbl_JmlBeli.Caption = "Jumlah Data : " & ADO_DBELI.Recordset.RecordCount
ADO_DBELI.Refresh
Txt_qty.Text = ""
Txt_harga.Text = ""
End Sub
Private Sub cbo_cari_KeyPress(keyascii As Integer)
 keyascii = AutoComplete(Cbo_cari, keyascii, False, Asli)
End Sub
Private Sub Cbo_KodeBrg_keypress(keyascii As Integer)
 keyascii = AutoComplete(Cbo_KodeBrg, keyascii, False, Asli)
End Sub
Private Sub Cbo_Kodepsk_keypress(keyascii As Integer)
 keyascii = AutoComplete(Cbo_KodePsk, keyascii, False, Asli)
End Sub

Private Sub Txt_JmlHtg_Change()
'txt_jmlHtg.Text = Format(txt_jmlHtg.Text, "#,#")
'txt_jmlHtg1.Text = Format(txt_jmlHtg.Text, "#")
End Sub

Private Sub txt_NoNota_KeyPress(keyascii As Integer)
Dim sTemplate As String
If Len(txt_NoNota) > 0 Then
DTP_TglBeli.Enabled = True
End If
  'Ganti '!@#$%^&*()_+=' dengan karakter yang Anda
  'inginkan untuk dihindari diinput pada Text1
  sTemplate = "`~@#$%^&*()_+|=\<,>?/;:'"""
If InStr(1, sTemplate, Chr(keyascii)) > 0 Then _
   keyascii = 0
'Pembacaan tombol Enter

If keyascii = 13 Then
   
    'Menjalankan fungsi TAB
    SendKeys vbTab
Else

    'Membuat huruf besar
    keyascii = Asc(UCase(Chr(keyascii)))
End If
End Sub
Private Sub txt_NoNota_change()
If txt_NoNota.Text = "" Then
DTP_TglBeli.Enabled = False
Else:
DTP_TglBeli.Enabled = True
End If
End Sub
Private Sub txt_NoNota_lostfocus()
If txt_NoNota.Text <> "" Then
   
    'Mencari Kode pada tabel
    sql = "select * from pembelian " & _
        " where nonotabeli='" & txt_NoNota.Text & "'"
    Set rs = Conn.Execute(sql)
      
    'Jika NoNOta sudah ada
    If Not rs.EOF Then
    MsgBox "No Nota Sudah Ada", vbCritical, ""
    DTP_TglBeli.Enabled = False
    Opt_Kredit.Enabled = False
    Opt_Tunai.Enabled = False
    Cbo_KodePsk.Enabled = False
    End If
  
End If
Cbo_KodePsk.Enabled = False
End Sub

Private Sub Txt_UangMuka_change()
Txt_Bayar.Enabled = True
End Sub
Private Sub Txt_UangMuka_lostfocus()
Txt_UangMuka.Text = Format(CCur("0" & Txt_UangMuka.Text), "#,##0")
If CCur("0" & Txt_UangMuka.Text) > CCur("0" & Txt_Gtotal.Text) Then
MsgBox "UangMuka Terlalu Besar"
Txt_UangMuka.SetFocus
Txt_UangMuka = 0
Else:
SendKeys vbEnter
End If
End Sub

Private Sub Txt_qty_keypress(keyascii As Integer)
''If Not (keyascii >= Asc("0") & Chr(13) _
''     And keyascii <= Asc("9") & Chr(13) _
''     Or keyascii = vbKeyBack _
''     Or keyascii = vbKeyDelete) And Not (keyascii = 13) Then
''        Beep
''        keyascii = 0
''        MsgBox "   Data Harus Angka"
'' Else
If keyascii = 46 Then
 keyascii = 0
 MsgBox "   Data Harus Angka "
ElseIf keyascii = 13 Then
SendKeys vbTab
End If
End Sub
Private Sub Txt_qty_lostfocus()
Dim StockAwl As Long
Dim StockMn As Long
Dim stockMx As Long
Call sambung
sql = "select * from Barang where kd_Barang='" & Cbo_KodeBrg.Text & "'"
Set rs = Conn.Execute(sql)
If Not rs.EOF Then
StockAwl = rs("stockAwal")
StockMn = rs("stockMin")
stockMx = rs("stockMax")
End If
If Val(Txt_qty.Text) + StockAwl > stockMx Then
MsgBox " Jumlah Barang Melebihi Stock Max ", vbCritical
Txt_qty.SetFocus
End If
End Sub

Private Sub Txt_discont_keypress(keyascii As Integer)
If Not (keyascii >= Asc("0") & Chr(13) _
     And keyascii <= Asc("9") & Chr(13) _
     Or keyascii = vbKeyBack _
     Or keyascii = vbKeyDelete) And Not (keyascii = 13) Then
        Beep
        keyascii = 0
        MsgBox "   Data Harus Angka"
 ElseIf keyascii = 46 Then
 keyascii = 0
 MsgBox "   Data Harus Angka "
ElseIf keyascii = 13 Then
SendKeys vbTab
End If
Txt_Discont.SetFocus
End Sub
Private Sub Txt_uangmuka_keypress(keyascii As Integer)
If Not (keyascii >= Asc("0") & Chr(13) _
     And keyascii <= Asc("9") & Chr(13) _
     Or keyascii = vbKeyBack _
     Or keyascii = vbKeyDelete) And Not (keyascii = 13) Then
        Beep
        keyascii = 0
        MsgBox "   Data Harus Angka"
 ElseIf keyascii = 46 Then
 keyascii = 0
 MsgBox "   Data Harus Angka "
ElseIf keyascii = 13 Then
SendKeys vbTab
End If
Txt_UangMuka.SetFocus
End Sub
Private Sub Txt_Bayar_keypress(keyascii As Integer)
If Not (keyascii >= Asc("0") & Chr(13) _
     And keyascii <= Asc("9") & Chr(13) _
     Or keyascii = vbKeyBack _
     Or keyascii = vbKeyDelete) And Not (keyascii = 13) Then
        Beep
        keyascii = 0
        MsgBox "   Data Harus Angka"
 ElseIf keyascii = 46 Then
 keyascii = 0
 MsgBox "   Data Harus Angka "
ElseIf keyascii = 13 Then
SendKeys vbTab
End If
Txt_Bayar.SetFocus
End Sub
Sub NoUrutOtomatisUntukJurnal()
'NoUrutOtomatisUntukJurnal
Dim j As Integer
Dim No As String
sql = "Select NoJurnal from jurnal order by NoJurnal desc"
Set rs = Conn.Execute(sql)

If rs.EOF = True Then
  txt_nojurnal.Text = "JU000001"
Else
  j = Val(Right(rs("NoJurnal"), 6))
  No = "JU" + Format(Str(j + 1), "000000")
  txt_nojurnal.Text = No
End If
End Sub

Selanjutnya kita akan membahas "Membuat Laporan Menggunakan Crystal Report 8.0". Klik tombol dibawah ini untuk lanjut ke pembahasan perikutnya.