Di sini saya akan membahas tentang cara membuat aplikasi penjualan yang sangat sederhana menggunakan visual basic 6.0 dengan database SQL Server 2000. Pastikan Anda sudah mengaktifkan SQL Server Service Manager. Untuk cara mengaktifkannya dapat dilihat disini. Kemudian buatlah database dengan nama �Penjualan�, caranya dapat dilihat disini. Lalu buatlah beberapa tabel dengan struktur tabel seperti di bawah ini adalah Modul Cara Membuat From Penjualan VB
MODUL
Public Conn As ADODB.Connection
Public RS As ADODB.Recordset
Sub BUKA_database()
Set Conn = New ADODB.Connection
Conn.CursorLocation = adUseClient
x = "Driver={Microsoft Access Driver (*.mdb)};" & _
"DBQ=TOKO.MDB;" & _
"DefaultDir=" & App.Path & "\;" & _
"PWD=;UID=admin;"
Conn.Open x
FORM
Code : Procedure Procedure
Sub TOMBOL_mulai()
Me.CMD_PENJUALAN_save.Visible = False
Me.CMD_PENJUALAN_cancel.Visible = False
Me.CMD_PENJUALAN_New.Visible = True
Me.CMD_PRINT_struk.Visible = True
Me.CMD_PENJUALAN_cari.Visible = True
Me.CMD_ITEM_save.Visible = False
Me.CMD_ITEM_Cancel.Visible = False
End Sub
Sub TOMBOL_di_saat_INPUT()
Me.CMD_PENJUALAN_save.Visible = True
Me.CMD_PENJUALAN_cancel.Visible = True
Me.CMD_PENJUALAN_New.Visible = False
Me.CMD_PRINT_struk.Visible = False
Me.CMD_PENJUALAN_cari.Visible = False
Me.CMD_ITEM_save.Visible = True
Me.CMD_ITEM_Cancel.Visible = True
End Sub
Sub SETTING_flexgrid()
With Me.MSHFlexGrid1
.Clear
.Cols = 6
.Rows = 50
.AllowBigSelection = True
.AllowUserResizing = flexResizeColumns
.SelectionMode = flexSelectionByRow
.GridColor = &HC0C0C0 'abuabu
'/----- bikin judul
.TextMatrix(0, 0) = "No"
.TextMatrix(0, 1) = "Kode"
.TextMatrix(0, 2) = "Nama"
.TextMatrix(0, 3) = "Harga"
.TextMatrix(0, 4) = "Jumlah"
.TextMatrix(0, 5) = "Subtotal"
'/----- lebar kolom
.ColWidth(0) = 300
.ColWidth(1) = 1500
.ColWidth(2) = 2500
.ColWidth(3) = 1000
.ColWidth(4) = 1000
.ColWidth(5) = 1000
'/----- nomer barang
For NO = 1 To .Rows - 1
.TextMatrix(NO, 0) = NO
Next
End With
End Sub
Sub KOSONG()
JUMLAH_item = 0
Me.TXT_no_penjualan = 0
Me.DTPicker1.Value = Date
Me.CMB_customer = ""
Me.TXT_namacustomer = ""
Me.CMB_barang = ""
Me.TXT_namabarang = ""
Me.TXT_harga = 0
Me.TXT_qty = 0
Me.TXT_subtotal = 0
Me.TXT_total = 0
Me.TXT_disc = 0
Me.TXT_setelah_disc = 0
End Sub
Sub ISI_CUSTOMER()
Me.CMB_customer.Clear
x = "SELECT * FROM CUSTOMER ORDER BY KDCUSTOMER"
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
If RS.RecordCount > 0 Then
While Not RS.EOF
Me.CMB_customer.AddItem RS.Fields("KDCUSTOMER")
RS.MoveNext
Wend
End If
RS.Close
Set RS = Nothing
End Sub
Sub ISI_BARANG()
Me.CMB_barang.Clear
x = "SELECT * FROM BARANG ORDER BY KDBARANG"
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
If RS.RecordCount > 0 Then
While Not RS.EOF
Me.CMB_barang.AddItem RS.Fields("KDBARANG")
RS.MoveNext
Wend
End If
RS.Close
Set RS = Nothing
End Sub
Sub HITUNG_total_penjualan()
On Error Resume Next
xx = 0
ttl = 0
With Me.MSHFlexGrid1
For brs = 1 To .Rows - 1
xx = .TextMatrix(brs, 5)
If IsNull(xx) = True Then xx = 0
ttl = ttl + xx
Next
End With
Me.TXT_total = ttl
Me.TXT_setelah_disc = Me.TXT_total - Me.TXT_disc
End Sub
Sub CARI_NAMA_BARANG()
On Error Resume Next
x = ""
x = " SELECT * FROM BARANG"
x = x & " WHERE KDBARANG='" & Me.CMB_barang & "' "
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
If RS.RecordCount > 0 Then
Me.TXT_namabarang = RS.Fields("NMBARANG")
Me.TXT_harga = RS.Fields("HARGA")
End If
RS.Close
Set RS = Nothing
End Sub
Sub CARI_NAMA_CUSTOMER()
On Error Resume Next
x = ""
x = " SELECT * FROM CUSTOMER "
x = x & " WHERE KDCUSTOMER='" & Me.CMB_customer & "' "
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
If RS.RecordCount > 0 Then
Me.TXT_namacustomer = RS.Fields("NMCUSTOMER")
End If
RS.Close
Set RS = Nothing
End Sub
Code di AWAL FORM
GENERAL - DECLARATION
Dim JUMLAH_item 'jumlah barang
Dim BARIS_edit 'baris yg sedang di edot ehhh edit..
Dim BARANG_edit 'FLAG, jika barang sedang di edit, bernilai=1
FORM - LOAD
Call BUKA_database
JUMLAH_item = 0
Call KOSONG
Call SETTING_flexgrid
Call ISI_BARANG
Call ISI_CUSTOMER
Call TOMBOL_mulai
Code di COMBO, TEXT
COMBO CUSTOMER - CLICK
Call CARI_NAMA_CUSTOMER
COMBO KODE BARANG - CLICK
Call CARI_NAMA_BARANG
CODE di TEXTBOX DISCOUNT : TXT-DISC -- KEYPRESS
If KeyAscii = 13 Then
Call HITUNG_total_penjualan
End If
Code di TOMBOL-TOMBOL
TOMBOL : INPUT PENJUALAN BARU
Call KOSONG
Call SETTING_flexgrid
Me.TXT_no_penjualan.SetFocus
Call TOMBOL_di_saat_INPUT
TOMBOL SIMPAN PENJUALAN
If Me.TXT_no_penjualan = "" Then
MsgBox "NO.PENJUALAN HARUS DI ISI..!", vbCritical
Exit Sub
End If
'-----hitung lagi------'
Call HITUNG_total_penjualan
'-----cek apakah NO_PENJUALAN sama/double-----'
x = ""
x = "SELECT * FROM PENJUALAN_H WHERE NO_PENJUALAN='" & Me.TXT_no_penjualan & "' "
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
If RS.RecordCount > 0 Then
MsgBox "NOMER PENJUALAN SUDAH ADA..!", vbCritical
RS.Close
Set RS = Nothing
Exit Sub
Else
'-----jika nomer baru, maka simpan data
RS.AddNew
RS!NO_PENJUALAN = Me.TXT_no_penjualan
RS!TGL = Me.DTPicker1.Value
RS!KDCUSTOMER = Me.CMB_customer
RS!TOTAL_PENJUALAN = Me.TXT_total
RS!DISC = Me.TXT_disc
RS!TOTAL_SETELAH_DISC = Me.TXT_setelah_disc
RS.Update
End If
RS.Close
Set RS = Nothing
'----- simpan detail---------------------------------------------�
With Me.MSHFlexGrid1
For BB = 1 To .Rows - 1
'-----cek apakah data di isi-----'
If .TextMatrix(BB, 1) <> "" Then
'-----simpan detail nya boooo-----'
x = " SELECT * FROM PENJUALAN_D"
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
RS.AddNew
RS!NO_PENJUALAN = Me.TXT_no_penjualan
RS!KDBARANG = .TextMatrix(BB, 1) '--kolom 1 >kdbarang
RS!HARGA = .TextMatrix(BB, 3) '--kolom 3 >harga
RS!JUMLAH = .TextMatrix(BB, 4) '--kolom 4 >jumlah
RS!SUBTOTAL = .TextMatrix(BB, 5) '--kolom 5 >subtotal
RS.Update
RS.Close
Set RS = Nothing
' '[--------------------------------------------------]
' '[ update stok, di table barang (-)
' '[--------------------------------------------------]
AA = ""
AA = AA & " UPDATE BARANG SET"
AA = AA & " STOK = STOK - " & .TextMatrix(BB, 4)
AA = AA & " WHERE KDBARANG='" & .TextMatrix(BB, 1) & "' "
Conn.Execute AA
End If
Next
End With
MSGBOX �Data penjualan telah di simpan..�
Call TOMBOL_mulai
TOMBOL : CANCEL PENJUALAN
BARANG_edit = 0
Call KOSONG
Call SETTING_flexgrid
Call TOMBOL_mulai
MsgBox "BATAL..", vbInformation
TOMBOL : CARI PENJUALAN
dt = InputBox("INPUT NO.PENJUALAN :")
If dt = "" Then
Exit Sub
End If
Call SETTING_flexgrid
'-----cari header-----'
q = ""
q = q & " SELECT * FROM PENJUALAN_H"
q = q & " WHERE NO_PENJUALAN='" & dt & "' "
Set RS = New ADODB.Recordset
RS.Open q, Conn, adOpenStatic, adLockOptimistic
If RS.EOF Then
MsgBox "DATA TIDAK ADA..", vbCritical
RS.Close
Set RS = Nothing
Exit Sub
End If
'-----munculkan header-----'
Me.TXT_no_penjualan = RS.Fields("NO_PENJUALAN")
Me.DTPicker1.Value = RS.Fields("TGL")
Me.CMB_customer = RS.Fields("KDCUSTOMER")
Me.TXT_total = RS.Fields("TOTAL_PENJUALAN")
Me.TXT_disc = RS.Fields("DISC")
Me.TXT_setelah_disc = RS.Fields("TOTAL_SETELAH_DISC")
RS.Close
Set RS = Nothing
'-----munculkan detail------------------------------------------------------'
q = ""
q = q & " SELECT * FROM PENJUALAN_D"
q = q & " WHERE NO_PENJUALAN='" & dt & "' "
Set RS = New ADODB.Recordset
RS.Open q, Conn
If Not RS.EOF Then
NO = 0
While Not RS.EOF
NO = NO + 1
With Me.MSHFlexGrid1
.TextMatrix(NO, 1) = RS.Fields("KDBARANG")
'/-----cari nama barang-----/
x = ""
x = "SELECT * FROM BARANG WHERE KDBARANG='" & RS("KDBARANG") & "' "
Set Rs2 = New ADODB.Recordset
Rs2.Open x, Conn, adOpenStatic, adLockOptimistic
.TextMatrix(NO, 2) = Rs2("NMBARANG")
Rs2.Close
Set Rs2 = Nothing
'/-----end------------------/
.TextMatrix(NO, 3) = RS.Fields("HARGA")
.TextMatrix(NO, 4) = RS.Fields("JUMLAH")
.TextMatrix(NO, 5) = RS.Fields("SUBTOTAL")
End With
RS.MoveNext
Wend
End If
RS.Close
Set RS = Nothing
Call CARI_NAMA_CUSTOMER
TOMBOL : PRINT BON PENJUALAN per NO,PENJUALAN
Set oL = New CrystalReport1
oL.Database.Tables(1).Location = App.Path & "\toko.mdb"
'---seleksi data untuk GROUP-----'
oL.GroupSelectionFormula = ""
oL.GroupSelectionFormula = "{PENJUALAN_H.NO_PENJUALAN}='" & Me.TXT_no_penjualan & "' "
With F_PRINT.CRViewer91
.EnableExportButton = True
.EnableRefreshButton = True
.DisplayGroupTree = False
.ReportSource = oL
.ViewReport
.Zoom 100
End With
F_PRINT.Show (1)
TOMBOL : PRINT SEMUA BON
Set oL = New CrystalReport1
oL.Database.Tables(1).Location = App.Path & "\toko.mdb"
'---hilangkan seleksi data GROUP-----'
oL.GroupSelectionFormula = ""
With F_PRINT.CRViewer91
.EnableExportButton = True
.EnableRefreshButton = True
.DisplayGroupTree = False
.ReportSource = oL
.ViewReport
.Zoom 100
End With
F_PRINT.Show (1)
Code TOMBOL ITEM BARANG (Detail)
TOMBOL : SAVE BARANG
'-----cek data item-----'
If Me.CMB_barang = "" Or Me.TXT_harga = "" Or Me.TXT_qty = "" Then
MsgBox "DATA ITEM BARANG HARUS DI ISI..", vbCritical
Exit Sub
End If
If Me.TXT_harga = 0 Or Me.TXT_qty = 0 Then
MsgBox "HARGA, QTY TIDAK BOLEH NOL (0)..", vbCritical
Exit Sub
End If
'/-------------- taro di grid------------------�
With Me.MSHFlexGrid1
.TextMatrix(BARIS_edit, 1) = Me.CMB_barang.Text
.TextMatrix(BARIS_edit, 2) = Me.TXT_namabarang.Text
.TextMatrix(BARIS_edit, 3) = Me.TXT_harga.Text
.TextMatrix(BARIS_edit, 4) = Me.TXT_qty.Text
.TextMatrix(BARIS_edit, 5) = Me.TXT_subtotal.Text
End With
Me.CMB_barang = ""
Me.TXT_namabarang = ""
Me.TXT_harga = ""
Me.TXT_qty = ""
Me.TXT_subtotal = 0
Me.CMB_barang.SetFocus
Call HITUNG_total_penjualan
TOMBOL : CANCEL BARANG
Me.CMB_barang = ""
Me.TXT_namabarang = ""
Me.TXT_harga = ""
Me.TXT_qty = ""
Me.TXT_subtotal = 0
BARANG_edit = 0
REPORT PENJUALAN 1-Many
FORM PREVIEW REPORT (F_Print)
CODE : FORM _ RESIZE
CRViewer91.Top = 0
CRViewer91.Left = 0
CRViewer91.Height = ScaleHeight
CRViewer91.Width = ScaleWidth
RANCANG DESIGN PRINT OUT BON PENJUALAN (1-Many) (CrystalReport1)
CODE:
TOMBOL : REFRESH DATA
x = " SELECT KDBARANG,NMBARANG,HARGA FROM BARANG ORDER BY NMBARANG"
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
If RS.RecordCount > 0 Then
Set Me.MSHFlexGrid1.DataSource = RS
With Me.MSHFlexGrid1
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 300
.ColWidth(1) = 1000 '--lebar kode
.ColWidth(2) = 3000 '--lebar nama barang
End With
RS.Close
Set RS = Nothing
Else
MsgBox "TIDAK ADA DATA..", vbInformation
Me.MSHFlexGrid1.Clear
End If
TOMBOL : AMBIL DATA
With F_PENJUALAN
.CMB_barang = Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1) '/---kodebarang
.TXT_namabarang = Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 2) '/---namabarang
.TXT_harga = Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 3) '/---harga
.TXT_qty = 0
.TXT_subtotal = 0
End With
Unload Me
CODE di TXT-CARI � CHANGE
On Error Resume Next
x = ""
'/-----query berdasarkan KDBARANG-----------------------------------/
If Option1.Value = True Then
x = " SELECT KDBARANG,NMBARANG,HARGA FROM BARANG "
x = x & " WHERE LEFT(KDBARANG," & Len(Me.TXT_cari) & ")='" & Trim(Me.TXT_cari) & "' "
x = x & " ORDER BY KDBARANG"
End If
'/-----query berdasarkan NMBARANG-----------------------------------/
If Option2.Value = True Then
x = " SELECT KDBARANG,NMBARANG,HARGA FROM BARANG "
x = x & " WHERE LEFT(NMBARANG," & Len(Me.TXT_cari) & ")='" & Trim(Me.TXT_cari) & "' "
x = x & " ORDER BY NMBARANG"
End If
Set RS = New ADODB.Recordset
RS.Open x, Conn, adOpenStatic, adLockOptimistic
If RS.RecordCount > 0 Then
Set Me.MSHFlexGrid1.DataSource = RS
With Me.MSHFlexGrid1
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 300
.ColWidth(1) = 1000 '--lebar kode
.ColWidth(2) = 3000 '--lebar nama barang
End With
End If
RS.Close
Set RS = Nothing
FORM � LOAD
Call BUKA_database
Selamat Mencoba
