• Recent Post

  • RSS R o o t s e c u r e

    • Verizon: Espionage hacking grows, with more from east Europe
      Hacking for espionage purposes is sharply increasing, with groups or national governments from Eastern Europe playing a growing role, according to one of the most comprehensive annual studies of computer intrusions. Spying intrusions traced back to any country in 2013 were blamed on residents of China and other East Asian nations 49 percent of the time, but […]
    • Google to refund buyers of 'fake' anti-virus app
      Google has decided that a smallish (for The Chocolate Factory) wad of cash is a trivial price to pay for maintaining its reputation, and has begun refunding punters who fell for the fake “virus shield” scam. Uncovered by Android Police earlier this month, the fake virus scanner was nothing more than an icon that changed shape when a user tapped it. The app h […]
    • Active malware campaign steals Apple passwords from jailbroken iPhones
      Security researchers have uncovered an active malware campaign in the wild that steals the Apple ID credentials from jailbroken iPhones and iPads.Tags: AppleiPhoneSecurity […]
    • Digging for answers: The "strong smell" of fraud from one Bitcoin miner maker
      For many crypto-minded libertarians, Bitcoin is the future of money. But that dream hasn't been helped much by the numerous high-profile legal cases involving the currency in recent years: The Bitcoin Savings and Trust hedge fund collapsed; uncertainty fueled the implosion of Mt. Gox, the currency's largest exchange; and the high-profile Silk Road […]
    • Former GitHub CEO leaves the company
      Tom Preston-Werner — founder of the immensely popular social coding site GitHub and its most prominent executive — has left the company in the wake of widely publicized sexual harassment investigation. GitHub, a tech-industry darling whose coding software is used by millions of developers worldwide, launched the investigation last month after one of the comp […]
    • 12 ethical dilemmas gnawing at developers today
      The tech world has always been long on power and short on thinking about the ramifications of this power. If it can be built, there will always be someone who will build it without contemplating a safer, saner way of doing so, let alone whether the technology should even be built in the first place. The software gets written. Who cares where and how it' […]
    • Even the most secure cloud storage may not be so secure, study finds
      Some cloud storage providers who hope to be on the leading edge of cloud security adopt a "zero-knowledge" policy in which vendors say it is impossible for customer data to be snooped on. But a recent study by computer scientists at Johns Hopkins University is questioning just how secure those zero knowledge tactics are.Tags: cloudSecurity […]
    • Most but not all sites have fixed Heartbleed flaw
      The world's top 1,000 websites have been patched to protect their servers against the "Heartbleed" exploit, but up to 2% of the top million were still vulnerable as of last week, according to a California security firm. On Thursday, Menifee, Calif.-based Sucuri Security scanned the top 1 million websites as ranked by Alexa Internet, a subsidia […]
    • Six clicks: Top six camera phones compared
      It's difficult to judge the camera capture capability of most high-end phones today because with the right lighting and setup you can capture great photos with nearly all of them. I took the latest and greatest phones out for a spin this weekend and tried to see if any device stood out from the rest. I took photos using the Samsung Galaxy S5, Apple iPho […]
    • Aereo analysis: Cloud computing at a crossroads
      The question of whether online broadcast television is to remain in the hands of a stodgy industry that once declared the VCR the enemy is being put directly before the Supreme Court. Broadcasters' latest legal target is 2-year-old upstart Aereo—which retransmits over-the-air broadcast television using dime-sized antennas to paying consumers, who can wa […]

Cyrus Rico

.::Everything Must Be Share::.

Program STOK Dengan VB dan Ms. Access

Program STOK Penjualan menggunakan VB dan Database Ms Access (Episode 5B)

Episode sebelumnya (Epesiode 5A) pembahasan seputar transaksi

pembelian, nah pada episode kali ini akan dibahas transaksi penjualan, cara menampilkan data serta tabel dan query yang digunakan.

Tetap menggunakan database sebelumnya yakni STOK.MDB yang dapat di download bersama program ini, maka singung terlebih dahulu tabel-tabel dan query yang dipergunakan sebagai berikut:

1. HJual, Untuk menampung data transaksi Penjualan maka dibuatkan 2 (dua) Tabel (HJual dan DJuali), ke 2 tabel dihubungkan dengan sebuah field kunci yakni NOFAKTUR, pembahasan tabel Hjual dan Djual mirip Hbeli dan DBeli pada tulisan yang lalu.

Struktur tabel HJual sbb:

Field Name Data Type Field Properties

NOFAKTUR Text Field Size 10, (Nomor Faktur Penjualan)

TGL Date/Time Field Size 8 otomatis (Tanggal Transaksi Penjualan)

CUSTOMER Text Field Size 50, (Nama Customer)

KETERANGAN Text Field Size 100 (Mencatat Keterangan Transaksi)

Buatkan index dengan nama XNOFAKTUR dari field NOFAKTUR yang bersifat Primarykey

2. DJual, Untuk menampung data many transaksi Penjualan, Struktur

Tabel DJual sbb:

Field Name Data Type Field Properties

NOFAKTUR Text Field Size 10, (Nomor Faktur Penjualan)

KODEBRG Text Field Size 18 (Kode Barang)

JML Number Integer,(Jumlah Barang yang di jual)

HARGA Number Single (Harga Jual Barang)

Field Nofaktur dapat di index akan tetapi tidak boleh bersifat Primarykey

3.TCustomer, Untuk menampung data Master Customer, Struktur

Tabelnya sbb:

Field Name Data Type Field Properties

KODECUST Text Field Size 5, (Kode Customer)

NAMACUST Text Field Size 100 (Nama Customer)

ALAMAT Text Field Size 255,(Alamat Customer)

TELPON Text Field Size 15(Nomor Telepon Customer)

Buatkan index dengan nama XKODECUST dari field KODECUST yang bersifat Primarykey

4. QJUAL, Adalah query untuk menampilkan record data penjualan,

Adapun struktur Query ini adalah melibatkan ke 3 tabel yang sudah dibuat (HJual, DJual dan TBarang) , lihat gambar dibawah ini:

Query QJual

Bila kesulitan membaca gambar maka dapat menempuh cara membuat query dengan mengcopy isi statement SQLnya melalui menu SQL View. Adapun SLQ Stringnya seperti dibawah ini:

SELECT HJUAL.NOFAKTUR, HJUAL.TGL, HJUAL.CUSTOMER, HJUAL.KETERANGAN, DJUAL.KODEBRG, TBARANG.NAMABRG, TBARANG.SATUAN, DJUAL.JML, DJUAL.HARGA, [DJUAL]![JML]*[DJUAL] [HARGA] AS SUBJUMLAH FROM TBARANG INNER JOIN (HJUAL INNER JOIN DJUAL ON HJUAL.NOFAKTUR = DJUAL.NOFAKTUR) ON TBARANG.KODEBRG = DJUAL.KODEBRG;

Catatan:

Baris perintah diatas tidak dipisahkan dengan enter, hilangkan dahulu efek enter tersebut dengan menekan tombol del di setiap diujung baris perintah.

6. QJJual, Adalah query untuk menghitung jumlah penjualan masing-masing barang, Adapun struktur Query berasal dari query QJUAL, lihat gambar dibawah ini:

Query QJJual MegadataKeterangan:

Bila kesulitan membaca gambar maka dapat menempuh cara membuat query dengan mengcopy isi statement SQLnya melalui menu SQL View. Adapun SLQ Stringnya seperti dibawah ini:

SELECT QJUAL.KODEBRG, QJUAL.NAMABRG, Sum(QJUAL.JML) AS JMLJUAL, Sum(QJUAL.HARGA) AS HARGAJUAL, Sum(QJUAL.SUBJUMLAH) AS SUBJUMLAHJUAL FROM QJUAL GROUP BY QJUAL.KODEBRG, QJUAL.NAMABRG;

Catatan:

Baris perintah diatas tidak dipisahkan dengan enter, hilangkan dahulu efek enter tersebut dengan menekan tombol del diujung baris perintah sehingga baris ke dua naik menyambung dengan baris pertama.

PROGRAM STOK PENJUALAN

FRMJUAL (Form Penjualan)

Form ini digunakan untuk melakukan transaksi pembelian, Desain dan Layout form seperti gambar dibawah:

Form Penjualan Megadata

Isi Perintah Form Penjelasan:

‘——- BOF FrmJual ————-

Public Mtotal As Single

Public RBaru As Boolean

Public SubHLama As Single

Sub HapusTbantu()

‘Hapus Tbantu

If Adodc1.Recordset.State = 1 Then

Adodc1.Recordset.close

End If

CN.Execute “delete * from Tbantu”

Adodc1.Recordset.Open “SELECT * FROM TBANTU”, CN

Adodc1.Refresh

Me.DataGrid1.ReBind

Me.DataGrid1.Refresh

End Sub

Private Sub Adodc1_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum,

ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset

As ADODB.Recordset)

‘baris perintah Parameter sub procedure tidak dipisahkan dengan enter

If adReason = adRsnAddNew Then

RBaru = True

Else

RBaru = False

End If

End Sub

Private Sub Adodc1_WillChangeRecordset(ByVal adReason As ADODB.EventReasonEnum,

adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

‘baris perintah Parameter sub procedure tidak dipisahkan dengan enter

If adReason = adRsnAddNew Then

RBaru = True

Else

RBaru = False

End If

End Sub

Private Sub cadd_Click()

Me.Text1.Text = “”

Me.Text2.Text = “”

Me.Text3.Text = “”

Me.Text4.Text = “”

cESave.Caption = “&Save”

Call HapusTbantu

Adodc1.Recordset.AddNew

Adodc1.Recordset!KOdeBrg = “”

Adodc1.Recordset.Update

Me.Refresh

Text1.SetFocus

Mtotal = 0

End Sub

Private Sub cDelete_Click()

‘Untuk menghapus data, Pada kasus ini Data yang terhapus

‘tidak dikembalikan ke master Stok,

‘artinya perhitungan akan salah jika mengunakan

‘rumus stok sebelumnya, untuk itu pembaca dapat memodifikasi

‘sub rutin ini khususnya pada penghapusan Djual berbentuk Loop

Dim Tanya As Byte

Tanya = MsgBox(“Anda yakin menghapus Transaksi yang tampil..” & Chr(10) & _

“Jumlah Barang yang dihapus tidak dikembalikan ke Stok”,

vbQuestion + vbYesNo, “HAPUS DATA”)

If Tanya = vbYes Then

CN.Execute “Delete * from Hjual Where NOFAKTUR=’” & Trim(Text1.Text) & “‘”

CN.Execute “Delete * from Djual Where NOFAKTUR=’” & Trim(Text1.Text) & “‘”

cadd_Click

MsgBox “Data sudah terhapus..”

End If

End Sub

Private Sub cESave_Click()

If cESave.Caption = “&Save” Then

cESave.Caption = “&Edit”

Set rsHJual = New ADODB.Recordset

rsHJual.Open “select * from HJual”, CN, adOpenKeyset, adLockOptimistic,adCmdText

rsHJual.AddNew

rsHJual!NoFaktur = Trim(Text1.Text)

rsHJual!tgl = DtJUal.Value

rsHJual!Customer = Trim(Text2.Text)

rsHJual!keterangan = Trim(Text3.Text)

Set rSDJual = New ADODB.Recordset

rSDJual.Open “select * from Djual “,CN,adOpenKeyset, adLockOptimistic,adCmdText

With Adodc1.Recordset

.MoveFirst

Do Until .EOF

If Len(Trim(!KOdeBrg)) > 0 Then

rSDJual.AddNew

rSDJual!NoFaktur = Trim(Text1.Text)

rSDJual!KOdeBrg = !KOdeBrg

rSDJual!Jml = !Jml

rSDJual!Harga = !HrgJual

Set rSB = New ADODB.Recordset

rSB.Open “select * from Tbarang where KODEBRG=’” & !KOdeBrg & “‘”,

CN, adOpenKeyset, adLockOptimistic, adCmdText

If rSB.EOF And rSB.BOF Then

Else

rSB!JUMLAH = rSB!JUMLAH – !Jml

rSB.Update

End If

rSDJual.Update

End If

.MoveNext

Loop

rsHJual.Update

End With

MsgBox “Data Penjualan sudah tersimpan”

else

‘Ini untuk tombol Edit

End If

End Sub

Private Sub cexit_Click()

Unload Me

End Sub

Private Sub DataGrid1_AfterColEdit(ByVal ColIndex As Integer)

Dim Kobrg As String

If ColIndex = 0 Then

Kobrg = Trim(DataGrid1.Columns(0).Text)

Set rSB = New ADODB.Recordset

rSB.Open “select * from Tbarang where KodeBrg =’” & Kobrg & “‘”,

CN, adOpenKeyset, adLockOptimistic, adCmdText

If rSB.EOF And rSB.BOF Then

MsgBox “Kode Barang ini tidak ada”

Else

With DataGrid1

.Columns(1).Text = rSB!NamaBrg

.Columns(2).Text = rSB!Satuan

.Columns(3).Text = rSB!HargaJual

End With

SendKeys “{RIGHT 4}”

End If

End If

If ColIndex = 4 Then

With DataGrid1

.Columns(5).Text = Val(.Columns(3).Text) * Val(.Columns(4).Text)

If RBaru Then

Mtotal = Mtotal + Val(.Columns(5).Text)

Else

Mtotal = (Mtotal – SubHLama) + Val(.Columns(5).Text)

End If

SubHLama = 0

Text4.Text = Format(Mtotal, “#,##0″)

End With

SendKeys “{DOWN}”

SendKeys “{HOME}”

End If

End Sub

Private Sub DataGrid1_BeforeColEdit(ByVal ColIndex As Integer,

ByVal KeyAscii As Integer, Cancel As Integer)

If ColIndex = 4 Then

SubHLama = Val(DataGrid1.Columns(5).Text)

End If

End Sub

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

TekanEnter (KeyCode)

End Sub

Private Sub Form_Load()

VFrmJual = True

Me.Width = 9420

Me.Height = 5550

Me.Left = (Screen.Width – Me.Width) \ 2

Me.Top = 1000

Adodc1.Recordset.close

CN.Execute “delete * from Tbantu”

Adodc1.Recordset.Open “select * from Tbantu”

Me.Adodc1.Refresh

Me.DataGrid1.Refresh

End Sub

Private Sub Form_Terminate()

‘VFrmJual = False

End Sub

Private Sub Form_Unload(Cancel As Integer)

VFrmJual = False

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

TekanEnter (KeyAscii)

End Sub

Private Sub Text1_LostFocus()

Dim Tanya As Integer

Mtotal = 0

If Len(Trim(Text1.Text)) > 0 Then

Set rsHJual = New ADODB.Recordset

rsHJual.Open “select * from Qjual where NOFAKTUR =’” &

Trim(Text1.Text)& “‘”, CN, adOpenKeyset,

adLockOptimistic, adCmdText

If rsHJual.EOF And rsHJual.BOF Then

Else

cESave.Caption = “&Edit”

Tanya = MsgBox(“Faktur Sudah pernah ada, Mau ditampilkan.? “,

vbQuestion + vbYesNo, “FAKTUR GANDA”)

If Tanya = vbYes Then

Text2.Text = rsHJual!Customer

DtJUal.Value = rsHJual!tgl

Text3.Text = rsHJual!keterangan

CN.Execute “delete * from Tbantu”

Set rSBantu = New ADODB.Recordset

rSBantu.Open “select * from Tbantu”, CN, adOpenKeyset,

adLockOptimistic,adCmdText

rsHJual.MoveFirst

Do Until rsHJual.EOF

rSBantu.AddNew

rSBantu!KOdeBrg = rsHJual!KOdeBrg

rSBantu!NamaBrg = rsHJual!NamaBrg

rSBantu!Satuan = rsHJual!Satuan

rSBantu!HrgJual = rsHJual!Harga

rSBantu!Jml = rsHJual!Jml

rSBantu!Subjumlah = rsHJual!Subjumlah

Mtotal = Mtotal + rsHJual!Subjumlah

rSBantu.Update

rsHJual.MoveNext

Loop

Set rsHJual = Nothing

Set rSBantu = Nothing

Adodc1.Recordset.close

Adodc1.Recordset.Open “sELECT * FROM TBANTU”, CN

Adodc1.Recordset.Requery -1

Adodc1.Refresh

DataGrid1.ReBind

DataGrid1.Refresh

Text4.Text = Format(Mtotal, “#,##0″)

Me.Refresh

End If

End If

End If

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

TekanEnter (KeyAscii)

End Sub

Private Sub Text2_LostFocus()

Dim RsCust As ADODB.Recordset

Set RsCust = New ADODB.Recordset

RsCust.Open “select * from TCUSTOMER where NamaCust =’”

& Trim(Text2.Text) & “‘”, CN, adOpenForwardOnly, adLockReadOnly

If RsCust.EOF And RsCust.BOF Then

MsgBox “Maaf Nama Customer ini tidak ada”

Text2.SetFocus

Exit Sub

End If

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

TekanEnter (KeyAscii)

End Sub

‘——— EOF File Form FrmJual —————

FVBarang (Form View Barang)

Form ini digunakan untuk menampilkan Jumlah pembelian, jumlah penjualan dan stok barang, Desain dan Layout form seperti gambar dibawah:

Form View Barang megadata

‘ ———– BOF FVBarang ———————–

Private Sub close_Click()

Unload Me

End Sub

Private Sub cview_Click()

If Option1.Value Then

Adodc1.Recordset.close

Adodc1.Recordset.Open “select * from QJMLBRG order by KODEBRG”, CN,

adOpenKeyset, adLockReadOnly, adCmdText

Adodc1.Recordset.Requery -1

DataGrid1.ReBind

DataGrid1.Refresh

End If

If Option2.Value Then

Adodc1.Recordset.close

Adodc1.Recordset.Open “select * from QJMLBRG where NAMABRG LIKE ‘%”

& Trim(Text1.Text) & “%’ order by NAMABRG”, CN,

adOpenKeyset, adLockReadOnly, adCmdText

Adodc1.Recordset.Requery -1

DataGrid1.ReBind

DataGrid1.Refresh

End If

If Option3.Value Then

Adodc1.Recordset.close

Adodc1.Recordset.Open “select * from QJMLBRG where JUMLAH <="

& Val(Trim(Text2.Text)) & ” order by NAMABRG”, CN,

adOpenKeyset,adLockReadOnly, adCmdText

Adodc1.Recordset.Requery -1

DataGrid1.ReBind

DataGrid1.Refresh

End If

End Sub

Private Sub Form_Load()

Me.Height = 5400

Me.Width = 9360

Me.Left = (Screen.Width – Me.Width) \ 2

Me.Top = 1000

End Sub

‘————- EOF FVBarang ————–

PENJELASAN:

Pada Source Program yg di download terdapat form MDI dan beberapa komponen lain seperti icon megadata, semata-mata sebagai bahan pembelajaran, Komponen lain seperti Tabel User dan Porgram Login serta form User akan disempurnakan pada modify berikutnya, ini dilakukan agar para pembaca yang bersifat pemula tidak terlalu merasa berat dengan listing program.

Demikian pembahasan STOK dan akan disambung pada tulisan berikutnya.

Silakan meninggalkan pesan untuk sesuatu yang perlu dijelaskan..

Download Program

Categories: Kuliah - Pemrograman