&& Form Transaksi Penjualan Metode Adodb &&
&& Modul &&
Public koneksi As New ADODB.Connection
Public rsoperator As New ADODB.Recordset
Public rstransaksi As New ADODB.Recordset
Public rsdetail As New ADODB.Recordset
Public rsbarang As New ADODB.Recordset
Sub buka_koneksi()
koneksi.CursorLocation = adUseClient
koneksi.Open
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path &
"\Access\data.mdb"
End Sub
Function nilaiangka(nteks As String)
nilaiangka =
Format(nteks, "##0")
End Function
&& Koding &&
Dim lvbarang As ListItem
Dim lvopr As ListItem
Dim sqlbarang As New ADODB.Recordset
Private Sub Form_Activate()
Me.txtkodeoperator.SetFocus
End Sub
Private Sub Form_Load()
buka_koneksi
If
rstransaksi.State = 0 Then rstransaksi.Open "select*from transaksi",
koneksi, adOpenKeyset, adLockOptimistic
rsdetail.Open
"select*from detail", koneksi, adOpenKeyset, adLockOptimistic
rsbarang.Open
"select*from hardware", koneksi, adOpenKeyset, adLockOptimistic
Me.txttgl.Text =
Format(Date, "dd-mmm-yyyy")
no_nota
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As
Integer)
Select Case
KeyCode
Case vbKeyF10
Image2_Click
Case
vbKeyEscape
teksbarangkosong
Me.txtpembayaran.SetFocus
End Select
End Sub
Sub no_nota()
Dim tgl As String
Dim bln As String
Dim thn As String
tgl = Day(Date)
If tgl < 10
Then
tgl =
"0" + tgl
End If
bln = Month(Date)
If bln < 10
Then bln = "0" + bln
thn = Year(Date)
With rstransaksi
If
.RecordCount > 0 Then .MoveLast
If
.RecordCount = 0 Then
Me.txtnota.Text = "T" + tgl + bln + thn + "000001"
Else
Me.txtnota.Text = "T" + tgl + bln + thn +
Right("000000" + Trim(Str(Val(Right(.Fields(0), 6)) + 1)), 6)
End If
End With
End Sub
Private Sub Image1_Click() ‘menampilkan
list operator
isilistoperator
Me.ListOperator.Height = 1785
Me.ListOperator.Visible = True
Me.ListOperator.SetFocus
End Sub
Sub isilistoperator()
If
rsoperator.State = adStateClosed Then
rsoperator.Open "select*From Operator", koneksi, adOpenKeyset,
adLockOptimistic
End If
With rsoperator
Me.ListOperator.ListItems.Clear
.MoveFirst
While Not .EOF
Set lvopr
= Me.ListOperator.ListItems.Add(, , .Fields(0))
lvopr.SubItems(1) = .Fields(1)
.MoveNext
Wend
End With
End Sub
Private Sub ListOperator_KeyPress(KeyAscii As Integer)
If KeyAscii = 13
Then
Me.txtkodeoperator.Text = Me.ListOperator.SelectedItem.Text
Me.txtnamaoperator.Text =
Me.ListOperator.ListItems(Me.ListOperator.SelectedItem.Index).SubItems(1)
Me.ListOperator.Visible = False
Me.txtkodebarang.SetFocus
End If
End Sub
Private Sub Image2_Click() ‘menampilkan
grid barang
isigridbarang
Me.gridbarang.Visible = True
Me.gridbarang.SetFocus
SendKeys
"{Right}"
End Sub
Sub isigridbarang()
If sqlbarang.State
= 0 Then sqlbarang.Open "select kdhard,nmhard,hargajual,stok from hardware
where stok>0", koneksi, adOpenKeyset, adLockReadOnly
Set
Me.gridbarang.DataSource = sqlbarang
End Sub
‘ingat supaya bisa setfocus ke txtjumlah : grid barang klik
kananà
property à
splits à
locked
Private Sub gridbarang_KeyPress(KeyAscii As Integer)
If KeyAscii = 13
Then
Me.txtkodebarang.Text = Me.gridbarang.Columns(0).Text
Me.txtnamabarang.Text = Me.gridbarang.Columns(1).Text
Me.txtharga.Text = Me.gridbarang.Columns(2).Text
Me.gridbarang.Visible = False
Me.txtjml.SetFocus
End If
End Sub
Private Sub txtjml_Change()
Me.txtsubtotal.Text = 0
Me.txtsubtotal.Text = Val(Me.txtharga.Text) * Val(Me.txtjml.Text)
End Sub
Private Sub txtjml_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Me.txtjml.Text
= "" Then
MsgBox
"Masukkan Jumlah Barang....", vbInformation + vbOKOnly,
"Informasi"
Else
'memasukkan
data barang ke listbarang
Set lvbarang =
Me.listbarang.ListItems.Add(, , Me.txtkodebarang.Text)
lvbarang.SubItems(1) = Me.txtnamabarang.Text
lvbarang.SubItems(2) = Me.txtharga.Text
lvbarang.SubItems(3) = Me.txtjml.Text
lvbarang.SubItems(4) =
Me.txtsubtotal.Text
'kosongkan
teks barang
teksbarangkosong
Me.txtkodebarang.SetFocus
'hitung total
Me.txtgrandtotal.Text = Format(hitungtotal, "#,#0")
End If
End If
End Sub
Function hitungtotal()
Dim SubTotal As
Long
SubTotal = 0
For i = 1 To
Me.listbarang.ListItems.Count
Set lvbarang =
Me.listbarang.ListItems(i)
SubTotal =
SubTotal + Val(Me.listbarang.ListItems(i).SubItems(4))
Next i
hitungtotal =
SubTotal
End Function
Sub teksbarangkosong()
Me.txtkodebarang.Text = ""
Me.txtnamabarang.Text = ""
Me.txtharga.Text =
""
Me.txtjml.Text =
""
Me.txtsubtotal.Text = ""
End Sub
Private Sub txtkodeoperator_KeyPress(KeyAscii As Integer)
If KeyAscii = 13
Then Image1_Click
End Sub
Private Sub txtkodebarang_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
With rsbarang
'pencarian
data melalui kode hardware
If
.RecordCount > 0 Then .MoveFirst
.Find
"kdhard='" & Me.txtkodebarang.Text & "'"
If Not .EOF
Then
'data
ditemukan
Me.txtnamabarang.Text = .Fields(1)
Me.txtharga.Text = .Fields(4)
Me.txtjml.SetFocus
Else
MsgBox "Data dengan kode :"
& Me.txtkodebarang.Text & vbCrLf & "Belum terdaftar....",
vbInformation + vbOKOnly, "Informasi"
End If
End With
End If
End Sub
Private Sub txtpembayaran_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If
Val(Me.txtpembayaran.Text) < Val(Me.txtgrandtotal) Then
MsgBox
"Maaf, uang pembayaran kurang...", vbInformation + vbOKOnly,
"Informasi"
Else
Me.txtkembali.Text = Format(Val(Me.txtpembayaran.Text) -
Val(Format(Me.txtgrandtotal.Text, "##0")), "#,#0")
Me.txtpembayaran.Text = Format(Me.txtpembayaran.Text, "#,#0")
cetaknota
simpandata
End If
End If
End Sub
Sub cetaknota()
Open
"C:\nota.txt" For Output As #1
Print #1, "
Nota Penjualan "
Print #1, "
Toko Serbaguna "
Print #1, "
Jl. Serayu Manis No. 20 "
Print #1, "
================================= "
Print #1, "
Nota : " & Me.txtnota.Text
Print #1, "
Tanggal : " & Me.txttgl.Text
Print #1, "
Kasir : " & Me.txtnamaoperator.Text
Print #1,
""
Print #1,
"Kode | Nama | Harga
| Jml | Total |"
For i = 1 To
Me.listbarang.ListItems.Count
Set lvbarang =
Me.listbarang.ListItems(i)
Print #1,
lvbarang.Text & Space$(5) & _
Me.listbarang.ListItems(i).SubItems(1) & Space$(10) & _
Me.listbarang.ListItems(i).SubItems(2) & Space$(5) & _
Me.listbarang.ListItems(i).SubItems(3) & Space$(4) & _
Me.listbarang.ListItems(i).SubItems(4)
Next
Print #1,
"---------------------------------------------------------------------"
Print #1,
"Grand Total : " & Me.txtgrandtotal.Text
Print #1,
"Bayar : " &
Me.txtpembayaran.Text
Print #1,
"Kembalian : " & Me.txtkembali.Text
Close #1
Open
"C:\Cetak1.bat" For Output As #2
Print #2,
"type C:\Nota.txt > prn"
Print #2,
"exit"
Close #2
Shell
"C:\Cetak1.bat"
End Sub
Sub simpandata()
'simpan ke tabel
transaksi
With rstransaksi
.AddNew
.Fields("Notrans") = Me.txtnota.Text
.Fields("tgl") = Format(Me.txttgl.Text,
"mm/dd/yyyy")
.Fields("jam") = Time
.Fields("kdopr") = Me.txtkodeoperator.Text
.Fields("grandtotal") = Format(Me.txtgrandtotal.Text,
"##0")
.Fields("bayar") = Format(Me.txtpembayaran.Text,
"##0")
.Fields("kembali") = nilaiangka(Me.txtkembali.Text)
.Update
End With
'simpan ke tabel
detail
For i = 1 To
Me.listbarang.ListItems.Count
Set lvbarang =
Me.listbarang.ListItems(i)
With rsdetail
.AddNew
.Fields("notrans") = Me.txtnota.Text
.Fields("kdhard") = lvbarang.Text
.Fields("hrg") = Me.listbarang.ListItems(i).SubItems(2)
.Fields("jml") = Me.listbarang.ListItems(i).SubItems(3)
.Update
End With
'update
stok barang/pengurangan stok barang
With
rsbarang
.MoveFirst
.Find
"kdhard='" & lvbarang & "'"
If Not
.EOF Then
.Fields("stok") = .Fields("stok") -
Val(Me.listbarang.ListItems(i).SubItems(3))
.Update
End If
End With
Next
End Sub