my script: program penjualan dengan acces

modul

Public con As New ADODB.Connection 'koneksi database
Public 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