program aplikasi penjualan vb 6

Aplikasi Penjualan VB 6.0

Dengan menggunakan pola yang sama seperti program pembelian, kita dapat membuat program penjualan. Perbedaannya hanya sedikit saja, yaitu pada program pembelian jumlah barang akan bertambah sedangkan pada program penjualan jumlah barang berkurang. Jika diperlukan kita dapat menambahkan tabel palanggan.

Normalisasi File

Model normalisasi file program penjualan dapat dilihat pada gambar di bawah ini, dengan asumsi penjualan ini sifatnya bebas (bukan hanya pada pelanggan) maka tabel pelanggan tidak dibuat.

Database Dan Tabel

Untuk mengetahui file database dan struktur masing-masing tabel berikut type data dan kunci primer maupun kunci tamunya silakan buka CD pendukung buku ini.

Asumsi – asumsi

Karena model program penjualan hampir sama dengan program pembelian maka disini kami ambil beberapa asumsi, antara lain:

1.              Pengolahan data barang telah dibuat

2.              Pengolahan data kasir telah dibuat

3.              Form login telah dibuat

Anda dapat melihat semua program yang disebutkan di atas dalam CD pendukung buku.

Membuat Module

Langkah awal pembuatan program penjualan kita mulai dengan pembuatan module dengan coding di bawah ini.

Public Conn As New ADODB.Connection

Public RSBarang As ADODB.Recordset

Public RSkasir As ADODB.Recordset

Public RSPenjualan As ADODB.Recordset

Public RSDetailJual As ADODB.Recordset

Public RSTR1 As ADODB.Recordset

Public RSTR2 As ADODB.Recordset

Public Sub BukaDB()

Set Conn = New ADODB.Connection

Set RSBarang = New ADODB.Recordset

Set RSkasir = New ADODB.Recordset

Set RSPenjualan = New ADODB.Recordset

Set RSDetailJual = New ADODB.Recordset

Set RSTR1 = New ADODB.Recordset

Set RSTR1 = New ADODB.Recordset

Conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ADOJual.mdb"

End Sub

Transaksi Penjualan

Ilustrasi pada program ini adalah sebagai berikut:

1.              Nomor faktur muncul secara otomatis, berubah setiap hari dan setiap ganti transaksi setelah faktur sebelumnya disimpan.

2.              Nama kasir dan kode kasir muncul secara otomatis dari hasil login. Kode kasir tidak ditampilkan dalam form (LblKodeKsr.Visible = False).

3.              Tanggal dan jam muncul secara otomatis diambil dari sistem komputer, oleh karena itu diharapkan mengecek kembali validasi tanggal dan jam komputer sebelum program dijalankan.

4.              Saat melakukan transaksi, kode barang dapat diketik di kolom kode atau mengambil dari list. Jika kode barang ditemukan maka datanya akan ditampilkan dan kita tinggal mengisi jumlah penjualannya.

5.              Jumlah total item barang dan total harga muncul otomatis setelah mengisi kode barang dan jumlah barang yang dibeli, begitupun dengan jumlah total harga.

6.              Terakhir kita tinggal mengisi jumlah pembayaran dan menyimpannya.

Data yang dihasilkan oleh program penjualan terlihat pada kedua tabel berikut.

Penjualan
Faktur	Tanggal	Jam	Total	Item	Dibayar	Kembali	KodeKsr
0709090001	08/09/07	10:38:26 PM	13750	6	15000	1250	KSR01

DetailJual
Faktur	KodeBrg	JmlJual
07090900011	KOP01	1
07090900012	MIE01	2
07090900013	PEP01	3

Dengan kondisi seperti itu, selebihnya keputusan ada pada pembaca, apakah akan memilih model pertama atau kedua. Jika kita mengikuti aturan main perancangan database maka model kedua dapat dikatakan lebih baik dari model pertama, karena dalam sebuah tabel harus ada satu kunci primer dan selebihnya adalah kunci tamu (dalam hal ini kode barang). Tetapi model kedua sisi kelemahannya adalah tidak dapat menyimpan data ke tabel detail dengan cara menggabungkan jumlah jual walaupun ada kode barang yang sama, karena kita akan kehilangan nomor faktur yang setiap barisnya terus berbeda.

 

Coding

Private Sub Timer1_Timer()

    Jam = Time$

End Sub

Private Sub Form_Activate()

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\ADOJual.mdb"

Adodc1.RecordSource = "Transaksi"

Set DTGrid.DataSource = Adodc1

DTGrid.Refresh

If KodeKsr = "" Then

    MsgBox "Kasir tidak terdeteksi"

    Login.Show

    Exit Sub

End If

Call BukaDB

RSBarang.Open "Barang", Conn

List1.Clear

Do Until RSBarang.EOF

    List1.AddItem RSBarang!NamaBrg & Space(50) & RSBarang!KodeBrg

    RSBarang.MoveNext

Loop

Call Auto

Call Tabel_Kosong

Adodc1.Recordset.MoveFirst

Tanggal = Date

CmdSimpan.Enabled = False

End Sub

Private Sub Form_Load()

    KodeKsr = Login.TxtKodeKsr

    NamaKsr = Login.TxtNamaKsr

    DTGrid.Col = 1

    CmdSimpan.Enabled = False

End Sub

Private Sub Auto()

Call BukaDB

RSPenjualan.Open "select * from Penjualan Where Faktur In(Select Max(Faktur)From Penjualan)Order By Faktur Desc", Conn

RSPenjualan.Requery

    Dim Urutan As String * 10

    Dim Hitung As Long

    With RSPenjualan

        If .EOF Then

            Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "0001"

            Faktur = Urutan

        Else

            If Left(!Faktur, 6) <> Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) Then

                Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "0001"

            Else

                Hitung = (!Faktur) + 1

                Urutan = (Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2)) + Right("0000" & Hitung, 4)

            End If

        End If

        Faktur = Urutan

    End With

End Sub

Function Tabel_Kosong()

    Adodc1.Recordset.MoveFirst

    Do While Not Adodc1.Recordset.EOF

        Adodc1.Recordset.Delete

        Adodc1.Recordset.MoveNext

    Loop

    For i = 1 To 10

        Adodc1.Recordset.AddNew

        Adodc1.Recordset!Nomor = i

        Adodc1.Recordset.Update

    Next i

    DTGrid.Col = 1

End Function

Private Sub DTGrid_KeyDown(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

    Case vbKeyEscape

        Adodc1.Recordset!Kode = Null

        Adodc1.Recordset!Nama = Null

        Adodc1.Recordset!Harga = Null

        Adodc1.Recordset!Jumlah = Null

        Adodc1.Recordset!Total = Null

        Adodc1.Recordset.Update

        Call TotalItem

        Call TotalHarga

        DTGrid.Refresh

End Select

End Sub

Private Sub DTGrid_AfterColEdit(ByVal ColIndex As Integer)

    If DTGrid.Col = 1 Then

        Call BukaDB

        RSBarang.Open "Select * from Barang where Kodebrg='" & Adodc1.Recordset!Kode & "'", Conn

        If RSBarang.EOF Then

            Pesan = MsgBox("Kode Barang Tidak Terdaftar")

            DTGrid.Col = 1

            Exit Sub

        End If

        Adodc1.Recordset!Kode = RSBarang!KodeBrg

        Adodc1.Recordset!Nama = RSBarang!NamaBrg

        Adodc1.Recordset!Harga = RSBarang!HargaJual

        DTGrid.Col = 4

        DTGrid.Refresh

        Exit Sub

    End If

   

    If DTGrid.Col = 4 Then

        Adodc1.Recordset!Jumlah = Adodc1.Recordset!Jumlah

        Adodc1.Recordset!Total = Adodc1.Recordset!Harga * Adodc1.Recordset!Jumlah

        Adodc1.Recordset.Update

        Adodc1.Recordset.MoveNext

        DTGrid.Col = 1

        Call TotalHarga

        Call TotalItem

    End If

End Sub

Function TotalItem()

On Error Resume Next

Adodc1.Recordset.MoveFirst

Item = 0

Do While Not Adodc1.Recordset.EOF And Adodc1.Recordset!Jumlah <> 0

    Item = Item + Adodc1.Recordset!Jumlah

    Adodc1.Recordset.MoveNext

    Item = Item

Loop

End Function

Function TotalHarga()

On Error Resume Next

Adodc1.Recordset.MoveFirst

Total = 0

Do While Not Adodc1.Recordset.EOF And Adodc1.Recordset!Total <> 0

    Total = Total + Adodc1.Recordset!Total

    Adodc1.Recordset.MoveNext

    Total = Format(Total, "#,###,###")

Loop

End Function

Private Sub Bersihkan()

    Item = ""

    Total = ""

    Dibayar = ""

    Kembali = ""

End Sub

Private Sub Dibayar_KeyPress(Keyascii As Integer)

    If Keyascii = 13 Then

        If Dibayar = "" Or Val(Dibayar) < (Total) Then

            MsgBox "Jumlah Pembayaran Kurang"

            Dibayar.SetFocus

        Else

            Dibayar = Format(Dibayar, "###,###,###")

            If Dibayar = Total Then

                Kembali = Dibayar - Total

            Else

                Kembali = Format(Dibayar - Total, "###,###,###")

            End If

        CmdSimpan.Enabled = True

        CmdSimpan.SetFocus

        End If

    End If

    If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0

End Sub

Private Sub CmdSimpan_Keypress(Keyascii As Integer)

    If Keyascii = 27 Then

        CmdSimpan.Enabled = False

        Dibayar = ""

        Dibayar.SetFocus

    End If

End Sub

Private Sub CmdSimpan_Click() 

    Dim SQLTambahJual As String

    SQLTambahJual = "Insert Into Penjualan(Faktur,Tanggal,Jam,Total,Item,Dibayar,Kembali,KodeKsr)" & _

    "values('" & Faktur & "','" & Tanggal & "','" & Jam & "','" & Total & "','" & Item & "','" & Dibayar & "','" & Kembali & "','" & KodeKsr & "')"

    Conn.Execute (SQLTambahJual)

        

    Adodc1.Recordset.MoveFirst

    Do While Not Adodc1.Recordset.EOF

        If Adodc1.Recordset!Kode <> vbNullString Then

            Dim SQLTambahDetail As String

            SQLTambahDetail = "Insert Into Detailjual(Faktur,Kodebrg,JmlJual) " & _

            "values ('" & Faktur + Adodc1.Recordset!Nomor & "','" & Adodc1.Recordset!Kode & "','" & Adodc1.Recordset!Jumlah & "')"

            Conn.Execute (SQLTambahDetail)

        End If

    Adodc1.Recordset.MoveNext

    Loop

       

    Adodc1.Recordset.MoveFirst

    Do While Not Adodc1.Recordset.EOF

        If Adodc1.Recordset!Kode <> vbNullString Then

            Call BukaDB

            RSBarang.Open "Select * from Barang where Kodebrg='" & Adodc1.Recordset!Kode & "'", Conn

            If Not RSBarang.EOF Then

                Dim Kurangi As String

                Kurangi = "update barang set jumlahbrg='" & RSBarang!JumlahBrg - Adodc1.Recordset!Jumlah & "' where kodebrg='" & Adodc1.Recordset!Kode & "'"

                Conn.Execute (Kurangi)

            End If

        End If

    Adodc1.Recordset.MoveNext

    Loop

    Bersihkan

    Form_Activate

    Call Cetak

End Sub

Private Sub CmdBatal_Click()

    Dibayar = ""

    Total = ""

    Item = ""

    Form_Activate

End Sub

Private Sub Cmadodc1utup_Click()

    Unload Me

End Sub

Function Cetak()

Call BukaDB

RSPenjualan.Open "select * from penjualan Where Faktur In(Select Max(Faktur)From penjualan)Order By Faktur Desc", Conn

Layar.Show

Dim Total, JmlJual, JmlHasil As Double

Dim MGrs As String

Layar.Font = "Courier New"

Layar.Print

Layar.Print

RSkasir.Open "select * From Kasir where KodeKsr= '" & RSPenjualan!KodeKsr & "'", Conn

Layar.Print Tab(5); "Faktur     :   "; RSPenjualan!Faktur

Layar.Print Tab(5); "Tanggal    :   "; Format(RSPenjualan!Tanggal, "DD-MMMM-YYYY")

Layar.Print Tab(5); "Jam        :   "; Format(RSPenjualan!Jam, "HH:MM:SS")

Layar.Print Tab(5); "Kasir      :   "; RSkasir!NamaKsr

MGrs = String$(33, "-")

Layar.Print Tab(5); MGrs

RSDetailJual.Open "select * from detailjual Where left(Faktur,10)='" & RSPenjualan!Faktur & "'", Conn

RSDetailJual.MoveFirst

No = 0

Do While Not RSDetailJual.EOF

    No = No + 1

    Set RSBarang = New ADODB.Recordset

    RSBarang.Open "select * From Barang where Kodebrg= '" & RSDetailJual!KodeBrg & "'", Conn

    RSBarang.Requery

    Harga = RSBarang!HargaJual

    Jumlah = RSDetailJual!JmlJual

    Hasil = Harga * Jumlah

    Layar.Print Tab(5); No; Space(2); RSBarang!NamaBrg

    Layar.Print Tab(10); RKanan(Jumlah, "##"); Space(1); "X";

    Layar.Print Tab(15); Format(Harga, "###,###,###");

    Layar.Print Tab(25); RKanan(Hasil, "###,###,###")

    RSDetailJual.MoveNext

Loop

Layar.Print Tab(5); MGrs

Layar.Print Tab(5); "Total      :";

Layar.Print Tab(25); RKanan(RSPenjualan!Total, "###,###,###");

Layar.Print Tab(5); "Dibayar    :";

Layar.Print Tab(25); RKanan(RSPenjualan!Dibayar, "###,###,###");

Layar.Print Tab(5); MGrs

Layar.Print Tab(5); "Kembali    :";

If RSPenjualan!Dibayar = RSPenjualan!Total Then

    Layar.Print Tab(34); RSPenjualan!Dibayar - RSPenjualan!Total

Else

    Layar.Print Tab(25); RKanan(RSPenjualan!Dibayar - RSPenjualan!Total, "###,###,###");

End If

Layar.Print Tab(5); MGrs

Layar.Print Tab(5); "Terima Kasih atas kunjungan Anda"

Layar.Print

Layar.Print

Layar.Print

Conn.Close

End Function

Private Function RKanan(NData, CFormat) As String

    RKanan = Format(NData, CFormat)

    RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan

End Function

Private Sub List1_keyPress(Keyascii As Integer)

    If Keyascii = 13 Then

        If DTGrid.SelText <> Right(List1, 5) Then

            DTGrid.SelText = Right(List1, 5)

            Adodc1.Recordset.Update

            Call BukaDB

            RSBarang.Open "Select * from Barang where KodeBrg='" & Right(List1, 5) & "'", Conn, adOpenDynamic, adLockOptimistic

            RSBarang.Requery

            If Not RSBarang.EOF Then

                Adodc1.Recordset!Kode = RSBarang!KodeBrg

                Adodc1.Recordset!Nama = RSBarang!NamaBrg

                Adodc1.Recordset!Harga = RSBarang!HargaJual

                Adodc1.Recordset.Update

                DTGrid.SetFocus

                DTGrid.Col = 4

            End If

        End If

    End If

End Sub

Private Sub CmdTutup_Click()

Unload Me

End Sub

 

Laporan Penjualan

Catatan :

Dengan kecerdikan yang Anda miliki, kami yakin Anda dapat membuat program penjualan dengan konsep ADO hanya dalam waktu 3 menit saja. Caranya adalah sebagai berikut :

1.              Salinlah semua program pembelian ke folder lain.

2.              Ubah nama database dari ADOBeli.mdb menjadi ADOJual.mdb

3.              Ubahlah semua hal yang berkaitan dengan kata BELI menjadi kata JUAL

4.              Buanglah semua hal yang berkaitan dengan tabel pemasok (jika itu memang tidak dibutuhkan, artinya penjualan yang dilakukan sifatnya bebas).

5.              Sebaliknya, jika penjualan ini sifatnya terbatas hanya pada pelanggan, maka ubahlah semua hal yang berkaitan dengan tabel pemasok menjadi tabel pelanggan.

6.              Jika data yang disimpan akan dibuat mirip dengan program pembelian (nomor faktur di tabel detail disimpan berulang tanpa adanya penambahan nomor urut transaksi yang diambil dari Grid), maka hapuslah coding berikut ini (yang dicetak tebal) pada saat data disimpan.

    Adodc1.Recordset.MoveFirst

    Do While Not Adodc1.Recordset.EOF

        If Adodc1.Recordset!Kode <> vbNullString Then

            Dim SQLTambahDetail As String

            SQLTambahDetail = "Insert Into Detailjual(Faktur,Kodebrg,JmlJual) " & _

            "values ('" & Faktur + Adodc1.Recordset!nomor & "','" & Adodc1.Recordset!Kode & "','" & Adodc1.Recordset!Jumlah & "')"

            Conn.Execute (SQLTambahDetail)

        End If

    Adodc1.Recordset.MoveNext

    Loop

Sekarang, bagaimana menurut Anda, membuat program penjualan begitu mudah bukan..?. dan terakhir, kembali gunakan kecerdikan Anda..! bukankah  dengan kedua program tersebut Anda dapat membuat program inventori…?.