modul
Public con As New ADODB.Connection 'koneksi databasePublic rcd As New ADODB.Recordset 'pengolahan record
Public dtg As New ADODB.Recordset 'penggunaan datagrid
Public ctrl As Control 'u/ pembacaan kontrol
Public nvg As New ADODB.Recordset 'u/navigasi record
Public fld As ADODB.Field 'u/ pembacaan forld
Public lst As ListItem 'untuk mewakili listitem di listview
Sub main()
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\infentory.accdb;Persist Security Info=False"
Form5.Show
End Sub
Public Sub bersih(frm As Form)
For Each ctrl In frm.Controls
If (TypeOf ctrl Is ComboBox) Then ctrl.Text = ""
If (TypeOf ctrl Is TextBox) Then ctrl.Text = ""
If (TypeOf ctrl Is OptionButton) Then ctrl.Value = False
If (TypeOf ctrl Is CheckBox) Then ctrl.Value = 0
Next ctrl
End Sub
input data barang
Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Combo2.SetFocus: SendKeys "{home}+{end}"
End If
End Sub
Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then
Combo2.SetFocus: SendKeys "{home}+{end}"
Else
If KeyCode = 38 Then
Text3.SetFocus: SendKeys "{home}+{end}"
End If
End If
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text4.SetFocus: SendKeys "{home}+{end}"
End If
End Sub
Private Sub Combo2_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then
Combo1.SetFocus: SendKeys "{home}+{end}"
Else
If KeyCode = 40 Then
Text4.SetFocus: SendKeys "{home}+{end}"
End If
End If
End Sub
Private Sub DataGrid1_DblClick()
If dtg.RecordCount <> 0 Then
Text2.Text = dtg!kode_barang
Call Text2_KeyPress(13)
SSTab1.Tab = 0
End If
End Sub
Private Sub DataGrid1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call DataGrid1_DblClick
End Sub
Private Sub Form_Load()
Combo1.AddItem "ELEKTRONIK"
Combo1.AddItem "FOOD"
Combo1.AddItem "INSTAN"
Combo2.AddItem "UNIT"
Combo2.AddItem "BOX"
Combo2.AddItem "GONI"
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select * from tabel_barang", con, 3, 2
For Each fld In rcd.Fields
Combo3.AddItem fld.Name
Next fld
Call tampil
End Sub
Private Sub Text1_Change()
If Combo3.Text <> Empty Then
If dtg.State <> adStateClosed Then dtg.Close
dtg.CursorLocation = adUseClient
dtg.Open "select * from tabel_barang where " & Combo3.Text & _
" like '" & Replace(Text1.Text, "'", "''") & "%'", con, 3, 4
Set DataGrid1.DataSource = dtg
DataGrid1.Refresh
End If
'select * from tabel_barang where nama_barang like 'jum'at%'
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select*from tabel_barang where kode_barang='" & Text2.Text & "'", con, 3, 2
If rcd.EOF = False Then
Text3.Text = rcd!nama_barang
Combo1.Text = rcd!jenis
Combo2.Text = rcd!satuan
Text4.Text = rcd!harga
Text5.Text = rcd!stock
Else
'MsgBox " Data Tidak di Temukan..."
Text3.SetFocus: SendKeys "{home}+{end}"
End If
End If
End Sub
Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then
Text5.SetFocus: SendKeys "{home}+{end}"
If KeyCode = 40 Then
Text3.SetFocus: SendKeys "{home}+{end}"
Call tampil
End If
End If
End Sub
Private Sub Text2_LostFocus()
Call Text2_KeyPress(13)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Combo1.SetFocus: SendKeys "{home}+{end}"
Call tampil
End If
End Sub
Private Sub Text3_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then
Combo1.SetFocus: SendKeys "{home}+{end}"
Else
If KeyCode = 38 Then
Text2.SetFocus: SendKeys "{home}+{end}"
Call tampil
End If
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text5.SetFocus: SendKeys "{home}+{end}"
Call tampil
End If
End Sub
Private Sub Text4_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then
Combo2.SetFocus: SendKeys "{home}+{end}"
Else
If KeyCode = 40 Then
Text5.SetFocus: SendKeys "{home}+{end}"
Call tampil
End If
End If
End Sub
'Private Sub Text5_KeyPress(KeyAscii As Integer)
'If KeyAscii = 13 Then
'If rcd.State <> adStateClosed Then rcd.Close
'rcd.Open "select*from tabel_barang", con, 3, 2
'rcd.AddNew
'rcd!kode_barang = Text2.Text
'rcd!nama_barang = Text3.Text
'rcd!jenis = Combo1.Text
'rcd!satuan = Combo2.Text
'rcd!harga = Text4.Text
'rcd!stock = Text5.Text
'rcd.Update
'MsgBox "Data Sudah Tersimpan..."
'Call baru
'
'Text2.SetFocus
'
'End If
'End Sub
Private Sub Text5_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then
Text2.SetFocus: SendKeys "{home}+{end}"
Else
If KeyCode = 38 Then
Text4.SetFocus: SendKeys "{home}+{end}"
Call tampil
End If
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
Call baru
Case 3
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select*from tabel_barang", con, 3, 2
rcd.AddNew
rcd!kode_barang = Text2.Text
rcd!nama_barang = Text3.Text
rcd!jenis = Combo1.Text
rcd!satuan = Combo2.Text
rcd!harga = Text4.Text
rcd!stock = Text5.Text
rcd.Update
MsgBox "Data Sudah Tersimpan..."
Call baru
Case 4
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select*from tabel_barang where kode_barang='" & Text2.Text & "'", con, 3, 2
If rcd.EOF = False Then
rcd!nama_barang = Text3.Text
rcd!jenis = Combo1.Text
rcd!satuan = Combo2.Text
rcd!harga = Text4.Text
rcd!stock = Text5.Text
rcd.Update
MsgBox "Data Sudah di Ubah..."
Call baru
Text2.SetFocus
End If
Case 5
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select*from tabel_barang where kode_barang='" & Text2.Text & "'", con, 3, 2
If rcd.EOF = False Then
rcd.Delete
rcd.Update
MsgBox "Data Sudah di Hapus..."
Call baru
Text2.SetFocus
End If
Case 7
If MsgBox("Anda Yakin Ingin Keluar,,??", vbYesNo, "Hato Message") = vbYes Then
Unload Me
End If
End Select
End Sub
Private Sub baru()
Text5 = "": Text2 = "": Text3 = "": Text4 = ""
Combo1 = "": Combo2 = ""
Text2.SetFocus
Call tampil
End Sub
Private Sub tampil()
If dtg.State <> adStateClosed Then dtg.Close
dtg.CursorLocation = adUseClient
dtg.Open "select * from tabel_barang", con, 3, 4
Set DataGrid1.DataSource = dtg
DataGrid1.Refresh
End Sub
passwood
Private Sub Command1_Click()
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select * from tabel_user where user_name='" & _
Text1.Text & "'", con, 3, 4
If rcd.EOF = False Then
If rcd!Password = Text2.Text Then
MsgBox "Selamat Datang : " & Text1.Text
Unload Me
MDIForm1.Show
Else
MsgBox "Password salah, coba lagi..!!"
Text2.SetFocus
SendKeys "{home}+{end}"
End If
Else
MsgBox "User tidak terdaftar"
Text1.SetFocus
SendKeys "{home}+{end}"
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Text1 = "": Text2 = ""
End Sub
transaksi penjualan barang
Dim VStock As Integer
Private Sub Command1_Click()
Call bersih(Me) 'membersihkan form
ListView1.ListItems.Clear 'membersihkan listview
DTPicker1.Value = Date 'menampilkan tanggal sekarang
Call AutoNumber 'memanggil prosedur autonumber
Frame1.Visible = False
Text1.SetFocus
End Sub
Private Sub Command2_Click()
If ListView1.ListItems.Count <> 0 Then
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select * from table_penjualan", con, 3, 2
For brs = 1 To ListView1.ListItems.Count
rcd.AddNew
rcd!no_faktur = Text1
rcd!tgl_faktur = DTPicker1.Value
rcd!no_pelanggan = Text2
rcd!kode_barang = ListView1.ListItems(brs).Text
rcd!jumlah_jual = ListView1.ListItems(brs).SubItems(3)
'rcd!sub_total=listview1.listitem(brs).subitem(4)
rcd.Update
'mengurangi stock barang
con.Execute "update tabel_barang set stock=stock-'" & ListView1.ListItems(brs).SubItems(3) & "' where kode_barang='" & ListView1.ListItems(brs).Text & "'"
Next brs
MsgBox "transaksi pembelian sudah di simpan"
Else
MsgBox "masukan data barang yang di beli"
End If
End Sub
Private Sub Form_Load()
Call bersih(Me) 'membersihkan form
DTPicker1.Value = Date 'menampilkan tanggal sekarang
ListView1.ListItems.Clear 'membersihkan listview
Call AutoNumber
End Sub
Private Sub AutoNumber()
'mendapatkan no.faktur secara otomatis berurutan
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select*from table_penjualan order by no_faktur desc", con, 3, 4 'mengurutkan data penjualan berdasarkan no.faktur
If rcd.RecordCount <> 0 Then 'jika tabel penjualan tidak kosong
'maka no.faktur terakhir + 1
Text1 = Format(Val(rcd!no_faktur) + 1, "0####")
Else 'jika tabel pembelian kosong
Text1 = Format(1, "0####") 'no.faktur di mulai dari angka 1
End If
End Sub
Private Sub ListView1_KeyDown(KeyCode As Integer, Shift As Integer)
'del=46
'esc=27
If ListView1.ListItems.Count <> 0 Then
If KeyCode = 46 Then
Text12 = Val(Text12) - Val(ListView1.SelectedItem.SubItems(4))
Text13 = IIf(Val(Text12) > 1000000, Val(Text12) * 0.02, 0)
Text14 = Val(Text12) - Val(Text13)
'Text15 = Text14
Frame1.Visible = False: Text7.SetFocus
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Text1 <> Empty Then
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select * from query_penjualan where no_faktur= '" & Text1 & "'", con, 3, 4
ListView1.ListItems.Clear
Text12 = 0
If rcd.EOF = False Then
DTPicker1.Value = rcd!tgl_faktur
Text2 = rcd!no_pelanggan
ListView1.ListItems.Clear
Do While rcd.EOF = False
Set lst = ListView1.ListItems.Add(, , rcd!kode_barang)
lst.SubItems(1) = rcd!nama_barang
lst.SubItems(2) = rcd!harga
lst.SubItems(3) = rcd!jumlah_jual
lst.SubItems(4) = rcd!harga * rcd!jumlah_jual
Text12 = Val(Text12) + rcd!subtotal
Text13 = IIf(Val(Text12) > 1000000, Val(Text12) * 0.02, 0)
Text14 = Val(Text12) - Val(Text13)
rcd.MoveNext
Loop
Text2_KeyPress (13)
MsgBox "transaksi sudah ada"
Command2.Enabled = False
Else
Call AutoNumber
Text2.SetFocus
Command2.Enabled = True
End If
End If
End If
End Sub
Private Sub Text10_Change()
Text11 = Val(Text9) * Val(Text10)
End Sub
Private Sub Text10_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Val(Text10) <> 0 Then
If Val(Text10) > VStock Then
MsgBox "stock barang tidak mencukupi.." & vbCrLf & "stock barang tinggal:" & VStock
Text10.SetFocus: SendKeys "{home}+{end}"
Else
Set lst = ListView1.ListItems.Add(, , Text7)
lst.SubItems(1) = Text8
lst.SubItems(2) = Text9
lst.SubItems(3) = Text10
lst.SubItems(4) = Text11
'total penjualan
Text12 = Val(Text12) + Val(Text11)
'discount penjualan
Text13 = IIf(Val(Text12) > 100000, Val(Text12) * 0.02, 0)
'total bayar
Text14 = Val(Text12) - Val(Text13)
Text7 = "": Text8 = "": Text9 = "": Text10 = ""
Text11 = "": Text7.SetFocus: SendKeys "{home}+{end}"
End If
Else
MsgBox "masukan jumlah barang yang di jual.."
End If
End If
End Sub
Private Sub Text16_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Val(Text16) >= Val(Text15) Then
Text17 = Val(Text16) - Val(Text15)
Command2.SetFocus 'command simpan
Else
MsgBox "uangnya kurang...!!"
SendKeys "{home}+{end}"
End If
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Text2 <> empthy Then
If rcd.State <> adStateClosed Then rcd.Close
rcd.Open "select * from table_pelanggan where " & "no_pelanggan='" & Text2 & "'", con, 3, 2
If rcd.EOF = False Then
Text3 = rcd!nama_pelanggan
Text4 = rcd!alamat
Text5 = rcd!no_telepon
Text6 = rcd!Status
Text7.SetFocus
Else
Text3 = "": Text4 = "": Text5 = "": Text6 = ""
MsgBox "pelanggan tidak terdaftar"
SendKeys "{home}+{end}" 'memblok otomatis
End If
End If
End If
End Sub
Private Sub Text7_KeyDown(KeyCode As Integer, Shift As Integer)
If Command2.Enabled = True Then
If KeyCode = 27 Then
Frame1.Visible = True
Text15 = Text14 'total penjualan
Text16.SetFocus 'jumlah bayar
End If
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer) 'kode barang
If Command2.Enabled = True Then
If KeyAscii = 13 Then
If Text7 <> Empty Then
If rcd.State <> adsstateclosed Then rcd.Close
rcd.Open "select*from tabel_barang where " & "kode_barang='" & Text7 & "'", con, 3, 4
If rcd.EOF = False Then 'jika kode barang ditemukan
Text8 = rcd!nama_barang 'tampilkan nama barng
Text9 = rcd!harga 'tampilkan harga
VStock = rcd!stock
'----------------
If ListView1.ListItems.Count <> 0 Then
For brs = 1 To ListView1.ListItems.Count
If ListView1.ListItems(brs).Text = Text7 Then
VStock = VStock - Val(ListView1.ListItems(brs).SubItems(3))
End If
Next brs
End If
'----------------
Text10.SetFocus 'fokus ke jumlah beli
Else 'jika kode barang tidak ditemukan
VStock = 0
Text8 = "': text9='": Text10 = "": Text11 = "" 'bersihkan text barang
MsgBox "kode barang tidak terdaftar"
SendKeys "{home}+{end}" 'blok tex kode barang
End If
End If
End If
End If
End Sub
tampilan awal
Option Explicit
Private Sub Form_KeyPress(KeyAscii As Integer)
Unload Me
End Sub
Private Sub Form_Load()
lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
lblProductName.Caption = App.Title
End Sub
Private Sub Frame1_Click()
Unload Me
End Sub
Private Sub Timer1_Timer()
p.Value = p.Value + 1
If p.Value = p.Max Then Unload Me: Form3.Show
End Sub
form menu
Private Sub Input_Data_Barang_Click()
Form1.Show
End Sub
sampai seterus nya....
