Cara Membuat From Penjualan Visual Basic

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

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

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

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

Ulasan Visual Basic |

Berita :

Cara Membuat From Penjualan Visual Basic

Cara Membuat From Penjualan Visual Basic

Pengunjung

Media Fartner

Info Asyik

Terkini

Popular Post