Komponen Yang Dipakai :
1. Microsoft ADO Data Control 6.0 (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)
LIsting Module :
Public conn As New ADODB.Connection
Public rstransaksi As New ADODB.Recordset
Public Sub koneksi()
Set rstransaksi = New ADODB.Recordset
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Voucer.mdb"
End Sub
Listing/Coding Form :
Sub aktif()
txtnotrans.Enabled = True
txttanggal.Enabled = True
cmbkdkasir.Enabled = True
txtnmkasir.Enabled = True
cmbkdvoucer.Enabled = True
txtnmvoucer.Enabled = True
txtharga.Enabled = True
cmbkdcustomer.Enabled = True
txtnmcustomer.Enabled = True
txtjumbel.Enabled = True
txttotal.Enabled = True
txtbayar.Enabled = True
txtkembali.Enabled = True
End Sub
Sub nonaktif()
txtnotrans.Enabled = False
txttanggal.Enabled = False
cmbkdkasir.Enabled = False
txtnmkasir.Enabled = False
cmbkdvoucer.Enabled = False
txtnmvoucer.Enabled = False
txtharga.Enabled = False
cmbkdcustomer.Enabled = False
txtnmcustomer.Enabled = False
txtjumbel.Enabled = False
txttotal.Enabled = False
txtbayar.Enabled = False
txtkembali.Enabled = False
End Sub
Sub bersih()
txtnotrans.Text = ""
cmbkdkasir.Text = "--Silakan Pilih--"
txtnmkasir.Text = ""
cmbkdvoucer.Text = "--Silakan Pilih--"
txtnmvoucer.Text = ""
txtharga.Text = ""
cmbkdcustomer.Text = "--Silakan Pilih--"
txtnmcustomer.Text = ""
txtjumbel.Text = ""
txttotal.Text = ""
txtbayar.Text = ""
txtkembali.Text = ""
End Sub
Sub auto()
Dim no As String
Dim noint As Long
no = Format(Date, "yyyy")
With rstransaksi
If .RecordCount = 0 Then
no = no & "001"
Else
.MoveLast
If Format(Date, "yyyy") <> Val(Mid(!notrans, 1, 4)) Then
no = Format(Date, "yyyy") & "001"
Else
noint = Trim(Val(Right(!notrans, 2) + 1))
no = Format(Date, "yyyy") & Right("00" & noint, 3)
End If
End If
End With
txtnotrans.Text = no
End Sub
Private Sub Form_Load()
Call koneksi
conn.CursorLocation = adUseClient
rstransaksi.Open "Select * from Transaksi", conn
Set gridtransaksi.DataSource = rstransaksi.DataSource
End Sub
Private Sub Form_Activate()
nonaktif
bersih
cmdnew.Enabled = True
cmdsave.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
cmdnew.SetFocus
rsvoucer.Open "select * from Voucer", conn
rscustomer.Open "select * from Customer", conn
rskasir.Open "select * from Kasir", conn
While Not rsvoucer.EOF
cmbkdvoucer.AddItem rsvoucer!kdvoucer
rsvoucer.MoveNext
Wend
While Not rscustomer.EOF
cmbkdcustomer.AddItem rscustomer!kdcustomer
rscustomer.MoveNext
Wend
While Not rskasir.EOF
cmbkdkasir.AddItem rskasir!kdkasir
rskasir.MoveNext
Wend
End Sub
Private Sub Timer1_Timer()
txttanggal.Text = Format(Date, "dd-mm-yyyy")
txttanggal.Enabled = False
End Sub
Private Sub cmdnew_Click()
aktif
bersih
auto
txtnotrans.Enabled = False
cmbkdkasir.SetFocus
cmdnew.Enabled = False
cmdsave.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
cmdsave.Caption = "&Save"
End Sub
Private Sub cmbkdkasir_Click()
Dim cari As String
cari = "select * from Kasir where kdkasir = '" & cmbkdkasir.Text & "'"
Set rskasir = conn.Execute(cari, , adCmdText)
With rskasir
If Not .EOF Then
txtnmkasir.Text = rskasir!nmkasir
txtnmkasir.Enabled = False
End If
cmbkdvoucer.SetFocus
End With
End Sub
Private Sub cmbkdvoucer_Click()
Dim cari As String
cari = "select * from Voucer where kdvoucer = '" & cmbkdvoucer.Text & "'"
Set rsvoucer = conn.Execute(cari, , adCmdText)
With rsvoucer
If Not .EOF Then
txtnmvoucer.Text = rsvoucer!nama_voucer
txtharga.Text = rsvoucer!harga
End If
cmbkdcustomer.SetFocus
End With
End Sub
Private Sub cmbkdcustomer_Click()
Dim cari As String
cari = "select * from Customer where kdcustomer = '" & cmbkdcustomer.Text & "'"
Set rscustomer = conn.Execute(cari, , adCmdText)
With rscustomer
If Not .EOF Then
txtnmcustomer.Text = rscustomer!nmcustomer
End If
End With
txtjumbel.SetFocus
End Sub
Private Sub cmdsave_Click()
Dim save As String
save = "insert into Transaksi values('" & txtnotrans.Text & "','" & txttanggal.Text & "','" & cmbkdkasir.Text & "','" & cmbkdcustomer.Text & "','" & txtnmcustomer.Text & "','" & cmbkdvoucer.Text & "','" & txtnmvoucer.Text & "','" & txtharga.Text & "','" & txtjumbel.Text & "','" & txttotal.Text & "')"
conn.Execute save
MsgBox "Data Telah Tersimpan!"
Form_Load
nonaktif
cmdnew.Enabled = True
cmdsave.Enabled = False
cmdcancel.Enabled = True
cmdexit.Enabled = True
End Sub
Private Sub cmdcancel_Click()
p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")
If p = vbYes Then
nonaktif
bersih
End If
cmdnew.Enabled = True
cmdsave.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
End Sub
Private Sub txtjumbel_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txttotal.Text = Val(txtharga.Text) * Val(txtjumbel.Text)
txtbayar.SetFocus
End If
End Sub
Private Sub txtbayar_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtkembali.Text = Val(txtbayar.Text) - Val(txttotal.Text)
MsgBox "Terima Kasih!"
nonaktif
cmdsave.SetFocus
End If
End Sub
Private Sub cmdexit_Click()
p = MsgBox("Yakin Ingin Kembali Menuju Menu Utama..?!", vbQuestion + vbYesNo, "Quesiton")
If p = vbYes Then
End
End If
End Sub
Update Contact :
No Wa/Telepon (puat) : 085267792168
No Wa/Telepon (fajar) : 085369237896
Email : Fajarudinsidik@gmail.com
No Wa/Telepon (puat) : 085267792168
No Wa/Telepon (fajar) : 085369237896
Email: Fajarudinsidik@gmail.com
atau Kirimkan Private messanger melalui email dengan klik tombol order dibawah ini :
