Form Penjualan Grosir dan Eceran
Setelah
proses pembelian barang maka proses selanjutnya adalah proses penjualan barang
itu sendiri. Proses penjualan dalam toko-toko kecil hanya ada penjualan secara
eceran sedangkan pada toko yang cukup besar dan mempunyai beberapa cabang maka
dalam penjualannya akan terbagi dua jenis penjualan yang pertama adalah
penjualan grosir dan yang kedua adalah penjualan eceran. Pada dasarnya proses
penjualan grosir dan penjualan grosir dan eceran adalah sama akan tetapi pada
kenyataan ada beberapa toko yang membedakannya. Untuk kesempatan ini saya hanya
akan membuat proses penjualannya sama. Yang membedakan hanya jumlah diskon yang
diberikan kepada konsumen jika membeli secara grosir atau eceran. Untuk membuat
form penjualan grosir dan eceran yang diperlukan adalah :
|
Object
|
Properties
|
Setting
|
|
Form
|
Name
|
FrmBeliBarang
|
|
|
BorderStyle
|
0-None
|
|
|
BackColor
|
&H00FFC0C0&
|
|
|
StartUpPosition
|
2-CenterScreen
|
|
Label
|
Name
|
Label1
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Form Pembelian Barang
|
|
|
Name
|
Label2
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
No Kwitansi
|
|
|
Name
|
Label3
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Supplier
|
|
|
Name
|
Label4
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Tanggal Transaksi
|
|
|
Name
|
Label5
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
TanggalKirim
|
|
|
Name
|
Label6
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Nama Barang
|
|
|
Name
|
Label7
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Jumlah
|
|
|
Name
|
Label8
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Harga Beli
|
|
|
Name
|
Label9
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Biaya Kirim
|
|
|
Name
|
Label10
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Jumlah Bayar
|
|
|
Name
|
Label11
|
|
|
Font
|
Calibri
|
|
|
ForeColor
|
&H8000000D&
|
|
|
Caption
|
Diskon
|
|
Textbox
|
Name
|
TxtKwitansi
|
|
|
Appearance
|
0-Flat
|
|
|
Height
|
330
|
|
TDBDate
|
Name
|
TxtTgl
|
|
|
DisplyFormat
|
dd mmmm yyy
|
|
|
ButtonVisible
|
1-True
|
|
|
Height
|
330
|
|
|
Name
|
TxtTglKirim
|
|
|
DisplyFormat
|
dd mmmm yyy
|
|
|
ButtonVisible
|
1-True
|
|
|
Height
|
330
|
|
SSOleDBCombo
|
Name
|
CmbSupplier
|
|
|
Height
|
330
|
|
|
BackColorOdd
|
&H00FFC0C0&
|
|
|
Name
|
CmbBarang
|
|
|
Height
|
330
|
|
|
BackColorOdd
|
&H00FFC0C0&
|
|
TDBNumber
|
Name
|
TxtJumlah
|
|
|
Height
|
330
|
|
|
appearance
|
0-Flat
|
|
|
DisplayFormat
|
###,###,###,##0.00;(###,###,###,##0.00)
|
|
|
Format
|
###,###,###,##0.00
|
|
|
Name
|
TxtHarga
|
|
|
Height
|
330
|
|
|
appearance
|
0-Flat
|
|
|
DisplayFormat
|
###,###,###,##0.00;(###,###,###,##0.00)
|
|
|
Format
|
###,###,###,##0.00
|
|
|
Name
|
TxtKirim
|
|
|
Height
|
330
|
|
|
appearance
|
0-Flat
|
|
|
DisplayFormat
|
###,###,###,##0.00;(###,###,###,##0.00)
|
|
|
Format
|
###,###,###,##0.00
|
|
VBButton
|
Name
|
CmdSave
|
|
|
ButtonType
|
4-Mac
|
|
|
Caption
|
&Save
|
|
|
Name
|
CmdCancel
|
|
|
ButtonType
|
4-Mac
|
|
|
Caption
|
&Cancel
|
|
|
Name
|
CmdInput
|
|
|
ButtonType
|
4-Mac
|
|
|
Caption
|
&Cari
|
|
|
Name
|
vbButton1
|
|
|
ButtonType
|
3-WindowsXP
|
|
|
Caption
|
-
|
|
|
BackColor
|
&H00FFC0C0&
|
|
|
Name
|
vbButton2
|
|
|
ButtonType
|
3-WindowsXP
|
|
|
Caption
|
X
|
|
|
BackColor
|
&H00FFC0C0&
|
|
TDBGrid
|
Name
|
Grid
|
|
|
DeadAreaColor
|
&H00FFC0C0&
|
|
|
ColumnFooter
|
False
|
|
|
MarqueeStyle
|
2-HighlightCell
|
|
TDBGrid.
Column(0)
|
DataField
|
Noket
|
|
|
Caption
|
Nomor
|
|
TDBGrid.
Column(1)
|
DataField
|
Kodebarang
|
|
|
Caption
|
KodeBarang
|
|
|
Visible
|
False
|
|
TDBGrid.
Column(2)
|
DataField
|
NamaBarang
|
|
|
Caption
|
Nama Barang
|
|
TDBGrid.
Column(3)
|
DataField
|
Jumlah
|
|
|
Caption
|
Jumlah
|
|
TDBGrid.
Column(4)
|
DataField
|
HargaBeli
|
|
|
Caption
|
Harga Beli
|
|
TDBGrid.
Column(5)
|
DataField
|
BiayaKirim
|
|
|
Caption
|
Biaya Kirim
|
|
Adodc
|
Name
|
AdoBarang
|
|
|
Visible
|
False
|
|
|
Name
|
AdoKonsumen
|
|
|
Visible
|
False
|
Tampilan design form penjualan
grosir dan eceran :
|
Jual
Grosir
|
Jual
Eceran
|
 |
 |
Tampilan form penjualan grosir dan
eceran saat dijalankan :
|
Jual
Grosir
|
Jual
Eceran
|
 |
 |
Source code Form jual grosir :
Dim RsTemp4 As
New ADODB.Recordset
Dim
Keterangan1 As Integer
Dim Discount
As Double
Private Sub CmbBarang_Click()
TxtHarga =
Val(CmbBarang.Columns(2).Text)
TxtKirim =
Val(CmbBarang.Columns(3).Text)
End Sub
Private Sub
CmbBarang_DropDown()
AdoBarang.RecordSource
= ""
SQL =
"Select KodeBarang,NamaBarang,hargaGrosir,BiayaKirim from Barang order by
kodeBarang"
Set RSFind =
DbCon.Execute(SQL)
If RSFind.BOF
Then Exit Sub
AdoBarang.RecordSource
= SQL
AdoBarang.Refresh
With CmbBarang
.DataSourceList = AdoBarang
.DataFieldList = "NamaBarang"
.Columns(0).Visible = False
.Columns(1).Width = 5000
.Columns(2).Visible = False
.Columns(3).Visible = False
End With
End Sub
Private Sub
CmbBarang_GotFocus()
If
Trim(CmbKonsumen) = "" Or Not CmbKonsumen.IsItemInList Then
MsgBox "Konsumen Masih Kosong"
CmbKonsumen.SetFocus
Exit Sub
ElseIf
IsNull(TxtTgl) Then
MsgBox "Tgl Transaksi Masih
Kosong"
TxtTgl.SetFocus
Exit Sub
ElseIf
IsNull(TxtTglKirim) Then
MsgBox "Tgl Kirim Masih Kosong"
TxtTglKirim.SetFocus
Exit Sub
End If
End Sub
Private Sub
CmbKonsumen_DropDown()
AdoKonsumen.RecordSource
= ""
SQL =
"Select KodeKonsumen,NamaKonsumen from Konsumen order by
kodeKonsumen"
Set RSFind =
DbCon.Execute(SQL)
If RSFind.BOF
Then Exit Sub
AdoKonsumen.RecordSource
= SQL
AdoKonsumen.Refresh
With
CmbKonsumen
.DataSourceList = AdoKonsumen
.DataFieldList = "NamaKonsumen"
.Columns(0).Visible = False
.Columns(1).Width = 5000
.Columns(2).Visible = False
End With
End Sub
Private Sub
CmdCancel_Click()
Form_Load
End Sub
Private Sub
CmdInput_Click()
If Trim(CmbBarang)
= "" Or Not CmbBarang.IsItemInList Then
MsgBox "Nama Barang Masih Kosong"
CmbBarang.SetFocus
Exit Sub
ElseIf
TxtJumlah = 0 Then
MsgBox "Jumlah Barang masih 0"
TxtJumlah.SetFocus
Exit Sub
ElseIf
TxtHarga = 0 Then
MsgBox "Harga Masih Kosong"
TxtHarga.SetFocus
Exit Sub
ElseIf
TxtKirim = 0 Then
MsgBox "Biaya Kirim Masih 0"
TxtKirim.SetFocus
Exit Sub
End If
RsTemp4.Find
"namaBarang='" & Trim(CmbBarang) & "'", ,
adSearchForward, 1
If RsTemp4.EOF
Then
With RsTemp4
.AddNew
!NoKet = RsTemp4.RecordCount
!namaBarang = Trim(CmbBarang)
!KodeBarang =
Trim(CmbBarang.Columns(0).Text)
!Jumlah = Val(TxtJumlah)
!HargaGrosir = Val(TxtHarga)
!BiayaKirim = Val(TxtKirim)
.Update
End With
Grid.DataSource = RsTemp4
Grid.Refresh
HitungBayar
Else
MsgBox "Barang Sudah Diinputkan."
Exit Sub
End If
CmbBarang =
""
TxtJumlah = 0
TxtHarga = 0
TxtKirim = 0
CmbBarang.SetFocus
End Sub
Sub
HitungBayar()
Dim
JumlahBayar As Double
Grid.MoveFirst
While Not
Grid.EOF
With Grid
JumlahBayar = JumlahBayar +
(Val(.Columns(3)) * Val(.Columns(4))) + (Val(.Columns(3)) * Val(.Columns(5)))
Grid.MoveNext
End With
Wend
'Label10.Caption
= "Jumlah Bayar : Rp. " + Str(JumlahBayar)
Label10.Caption
= "Jumlah Bayar : Rp. " & FormatNumber(JumlahBayar)
If JumlahBayar
> 15000000 Then
Discount = Fix(JumlahBayar * 20 / 100)
Label11.Caption = "Diskon : Rp. "
& FormatNumber(Discount)
ElseIf
JumlahBayar > 10000000 Then
Discount = Fix(JumlahBayar * 15 / 100)
Label11.Caption = "Diskon : Rp. "
& FormatNumber(Discount)
ElseIf
JumlahBayar > 5000000 Then
Discount = Fix(JumlahBayar * 10 / 100)
Label11.Caption = "Diskon : Rp. "
& FormatNumber(Discount)
End If
End Sub
Private Sub
CmdSave_Click()
If RSFind.BOF
Then
MsgBox "List Barang Masih Kosong"
Exit Sub
End If
With RsTemp4
SQL = "Insert into JualGrosir
values('" & Trim(TxtKwitansi) & "','" &
FormatTgl(TxtTgl) & _
"','" &
Trim(CmbKonsumen) & "','" & FormatTgl(TxtTglKirim) &
"'," & Discount & ")"
DbCon.Execute SQL
.MoveFirst
While Not .EOF
SQL = "insert into DtlJualGrosir
values('" & Trim(TxtKwitansi) & "','" &
FormatTgl(TxtTgl) & _
"','" & !NoKet &
"','" & !KodeBarang & "'," & !Jumlah &
"," & !HargaGrosir & _
"," & !BiayaKirim
& ")"
DbCon.Execute SQL
.MoveNext
Wend
End With
MsgBox
"Data Saved"
FrmReturJual.CmbTransaksi.Refresh
Form_Load
End Sub
Private Sub
Form_Load()
AdoKonsumen.ConnectionString
= ConDB
AdoBarang.ConnectionString
= ConDB
Bersih
TxtKwitansi =
KodeAuto
Label10.Caption
= "Jumlah Bayar : "
Label11.Caption
= "Diskon : "
With RsTemp4
If .State Then .Close
.Fields.Append "NoKet",
adInteger, 4
.Fields.Append "KodeBarang",
adVarChar, 50
.Fields.Append "NamaBarang",
adVarChar, 50
.Fields.Append "Jumlah",
adInteger, 4
.Fields.Append "HargaGrosir",
adDouble, 8
.Fields.Append "BiayaKirim",
adDouble, 8
.Open
End With
End Sub
Sub Bersih()
CmbKonsumen =
""
TxtTgl = Null
TxtTglKirim =
Null
CmbBarang =
""
TxtJumlah = 0
TxtHarga = 0
TxtKirim = 0
End Sub
Function
KodeAuto()
'SQL =
"Select No_Urut from ServiceMobil order by No_Urut"
'Set RSFind =
DbCon.Execute(SQL)
'If Not
RSFind.BOF Then
' KodeAuto = RSFind!no_urut
' Exit Function
'End If
SQL =
"Select KodeTransaksi from JualGrosir order by KodeTransaksi Desc"
Set RSFind =
DbCon.Execute(SQL)
If RSFind.BOF
Then
KodeAuto = "0000001"
Else
KodeAuto =
Format(CInt(Left(RSFind!KodeTransaksi, 7)) + 1, "0000000")
End If
End Function
Private Sub
Grid_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode =
46 And Not RsTemp4.BOF Then
If Keterangan1 = 0 Then
MsgBox "Klik Salah Satu Item Di
Tabel"
Exit Sub
End If
RsTemp4.Find
"noket='" & Keterangan1 & "'", , adSearchForward, 1
If Not
RsTemp4.EOF Then
MsgBox RsTemp4!NoKet & "
Dibatalkan"
RsTemp4.Delete
End If
Keterangan1 = Keterangan1 + 1
RsTemp4.Find "noket='" &
Keterangan1 & "'", , adSearchForward, 1
While Not RsTemp4.EOF
With RsTemp4
.Clone
!NoKet = !NoKet - 1
.Update
End With
RsTemp4.MoveNext
Wend
Grid.Refresh
HitungBayar
End If
End Sub
Private Sub
Grid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Keterangan1 =
Val(Grid.Columns(0).Text)
End Sub
Private Sub
TxtHarga_GotFocus()
CmbBarang_GotFocus
End Sub
Private Sub
TxtJumlah_GotFocus()
CmbBarang_GotFocus
End Sub
Private Sub
TxtKirim_GotFocus()
CmbBarang_GotFocus
End Sub
Private Sub
vbButton1_Click()
Me.WindowState
= vbMinimized
End Sub
Private Sub
vbButton2_Click()
Unload Me
End Sub
Source code
form jual eceran :
Dim RsTemp5 As
New ADODB.Recordset
Dim
Keterangan1 As Integer
Dim Discount
As Double
Private Sub
CmbBarang_Click()
TxtHarga =
Val(CmbBarang.Columns(2).Text)
TxtKirim =
Val(CmbBarang.Columns(3).Text)
End Sub
Private Sub
CmbBarang_DropDown()
AdoBarang.RecordSource
= ""
SQL =
"Select KodeBarang,NamaBarang,hargaEcer,BiayaKirim from Barang order by
kodeBarang"
Set RSFind =
DbCon.Execute(SQL)
If RSFind.BOF
Then Exit Sub
AdoBarang.RecordSource
= SQL
AdoBarang.Refresh
With CmbBarang
.DataSourceList = AdoBarang
.DataFieldList = "NamaBarang"
.Columns(0).Visible = False
.Columns(1).Width = 5000
.Columns(2).Visible = False
.Columns(3).Visible = False
End With
End Sub
Private Sub
CmbBarang_GotFocus()
If
Trim(CmbKonsumen) = "" Or Not CmbKonsumen.IsItemInList Then
MsgBox "Konsumen Masih Kosong"
CmbKonsumen.SetFocus
Exit Sub
ElseIf
IsNull(TxtTgl) Then
MsgBox "Tgl Transaksi Masih
Kosong"
TxtTgl.SetFocus
Exit Sub
ElseIf
IsNull(TxtTglKirim) Then
MsgBox "Tgl Kirim Masih Kosong"
TxtTglKirim.SetFocus
Exit Sub
End If
End Sub
Private Sub
CmbKonsumen_DropDown()
AdoKonsumen.RecordSource
= ""
SQL =
"Select KodeKonsumen,NamaKonsumen from Konsumen order by
kodeKonsumen"
Set RSFind =
DbCon.Execute(SQL)
If RSFind.BOF
Then Exit Sub
AdoKonsumen.RecordSource
= SQL
AdoKonsumen.Refresh
With
CmbKonsumen
.DataSourceList = AdoKonsumen
.DataFieldList = "NamaKonsumen"
.Columns(0).Visible = False
.Columns(1).Width = 5000
.Columns(2).Visible = False
End With
End Sub
Private Sub
CmdCancel_Click()
Form_Load
End Sub
Private Sub
CmdInput_Click()
If
Trim(CmbBarang) = "" Or Not CmbBarang.IsItemInList Then
MsgBox "Nama Barang Masih Kosong"
CmbBarang.SetFocus
Exit Sub
ElseIf
TxtJumlah = 0 Then
MsgBox "Jumlah Barang masih 0"
TxtJumlah.SetFocus
Exit Sub
ElseIf
TxtHarga = 0 Then
MsgBox "Harga Masih Kosong"
TxtHarga.SetFocus
Exit Sub
ElseIf
TxtKirim = 0 Then
MsgBox "Biaya Kirim Masih 0"
TxtKirim.SetFocus
Exit Sub
End If
RsTemp5.Find "namaBarang='"
& Trim(CmbBarang) & "'", , adSearchForward, 1
If RsTemp5.EOF
Then
With RsTemp5
.AddNew
!NoKet = RsTemp5.RecordCount
!namaBarang = Trim(CmbBarang)
!KodeBarang =
Trim(CmbBarang.Columns(0).Text)
!Jumlah = Val(TxtJumlah)
!HargaEcer = Val(TxtHarga)
!BiayaKirim = Val(TxtKirim)
.Update
End With
Grid.DataSource = RsTemp5
Grid.Refresh
HitungBayar
Else
MsgBox "Barang Sudah Diinputkan."
Exit Sub
End If
CmbBarang =
""
TxtJumlah = 0
TxtHarga = 0
TxtKirim = 0
CmbBarang.SetFocus
End Sub
Sub
HitungBayar()
Dim
JumlahBayar As Double
Grid.MoveFirst
While Not
Grid.EOF
With Grid
JumlahBayar = JumlahBayar +
(Val(.Columns(3)) * Val(.Columns(4))) + (Val(.Columns(3)) * Val(.Columns(5)))
Grid.MoveNext
End With
Wend
'Label10.Caption
= "Jumlah Bayar : Rp. " + Str(JumlahBayar)
Label10.Caption
= "Jumlah Bayar : Rp. " & FormatNumber(JumlahBayar)
If JumlahBayar
> 15000000 Then
Discount = Fix(JumlahBayar * 15 / 100)
Label11.Caption = "Diskon : Rp. "
& FormatNumber(Discount)
ElseIf
JumlahBayar > 10000000 Then
Discount = Fix(JumlahBayar * 10 / 100)
Label11.Caption = "Diskon : Rp. "
& FormatNumber(Discount)
ElseIf
JumlahBayar > 5000000 Then
Discount = Fix(JumlahBayar * 5 / 100)
Label11.Caption = "Diskon : Rp. "
& FormatNumber(Discount)
End If
End Sub
Private Sub
CmdSave_Click()
If RSFind.BOF
Then
MsgBox "List Barang Masih Kosong"
Exit Sub
End If
With RsTemp5
SQL = "Insert into JualEcer
values('" & Trim(TxtKwitansi) & "','" &
FormatTgl(TxtTgl) & _
"','" &
Trim(CmbKonsumen) & "','" & FormatTgl(TxtTglKirim) &
"'," & Discount & ")"
DbCon.Execute SQL
.MoveFirst
While Not .EOF
SQL = "insert into DtlJualEcer
values('" & Trim(TxtKwitansi) & "','" &
FormatTgl(TxtTgl) & _
"','" & !NoKet &
"','" & !KodeBarang & "'," & !Jumlah &
"," & !HargaEcer & _
"," & !BiayaKirim
& ")"
DbCon.Execute SQL
.MoveNext
Wend
End With
MsgBox
"Data Saved"
FrmReturJual.CmbTransaksi.Refresh
Form_Load
End Sub
Private Sub
Form_Load()
AdoKonsumen.ConnectionString
= ConDB
AdoBarang.ConnectionString
= ConDB
Bersih
TxtKwitansi =
KodeAuto
With RsTemp5
If .State Then .Close
.Fields.Append "NoKet",
adInteger, 4
.Fields.Append "KodeBarang",
adVarChar, 50
.Fields.Append "NamaBarang",
adVarChar, 50
.Fields.Append "Jumlah",
adInteger, 4
.Fields.Append "HargaEcer",
adDouble, 8
.Fields.Append "BiayaKirim",
adDouble, 8
.Open
End With
End Sub
Sub Bersih()
CmbKonsumen =
""
TxtTgl = Null
TxtTglKirim =
Null
CmbBarang =
""
TxtJumlah = 0
TxtHarga = 0
TxtKirim = 0
End Sub
Function
KodeAuto()
'SQL =
"Select No_Urut from ServiceMobil order by No_Urut"
'Set RSFind =
DbCon.Execute(SQL)
'If Not
RSFind.BOF Then
' KodeAuto = RSFind!no_urut
' Exit Function
'End If
SQL =
"Select KodeTransaksi from JualEcer order by KodeTransaksi Desc"
Set RSFind =
DbCon.Execute(SQL)
If RSFind.BOF
Then
KodeAuto = "0000001"
Else
KodeAuto =
Format(CInt(Left(RSFind!KodeTransaksi, 7)) + 1, "0000000")
End If
End Function
Private Sub
Grid_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode =
46 And Not RsTemp5.BOF Then
If Keterangan1 = 0 Then
MsgBox "Klik Salah Satu Item Di
Tabel"
Exit Sub
End If
RsTemp5.Find
"noket='" & Keterangan1 & "'", , adSearchForward, 1
If Not
RsTemp5.EOF Then
MsgBox RsTemp5!NoKet & " Dibatalkan"
RsTemp5.Delete
End If
Keterangan1 = Keterangan1 + 1
RsTemp5.Find "noket='" &
Keterangan1 & "'", , adSearchForward, 1
While Not RsTemp5.EOF
With RsTemp5
.Clone
!NoKet = !NoKet - 1
.Update
End With
RsTemp5.MoveNext
Wend
Grid.Refresh
HitungBayar
End If
End Sub
Private Sub
Grid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Keterangan1 =
Val(Grid.Columns(0).Text)
End Sub
Private Sub
TxtHarga_GotFocus()
CmbBarang_GotFocus
End Sub
Private Sub
TxtJumlah_GotFocus()
CmbBarang_GotFocus
End Sub
Private Sub
TxtKirim_GotFocus()
CmbBarang_GotFocus
End Sub
Private Sub
vbButton1_Click()
Me.WindowState
= vbMinimized
End Sub
Private Sub
vbButton2_Click()
Unload Me
End Sub
Comments
Post a Comment