3/20/15
A3 ~ Mata Arjuna
6.1 Header penambahan stok iten Header digunakan sebagai data bantu untuk database penambahan stok item, pada field headr penambahan stok item terdiri dari NOMOR TRANSAKSI TANGGAL TRANSAKSI KODE SUPPLIER dan NAMA SUPPLIER dan YANG TERAKHIR NAMA USER Tidak ada koding pada bagian header penambahan stok item ini. 6.2 Database penambahan stok item Database penambahan stok item memuat informasi dengan mengacu pada header penambahan stok item, pada fiel database penambahn stok item terdiri dari NOMOR TRANSAKSI TANGGAL TRANSAKSI KODE SUPPLIER dan NAMA SUPPLIER NAMA USER NOMOR URUT ITEM KODE ITEM NAMA ITEM SPECIFIKASI ITEM MERK ITEM SATUAN ITEM dan JUMLAH MASUK STOK ITEM Untu lebih jelasnya silahkan buka Folder IPA-2 file APG5 Buka
sheet
HeaderPemasukan
dan
DatabasePemasukan Masuk kejendela visual basic editor, temukan desig userform "FormPemasukan" 6.2.a Design userform penambahan stok item
irembun.blogspot.com/2015/01/a3.html
1/21
3/20/15
A3 ~ Mata Arjuna
6.3 Ngoding userform penambahan stok item 6.3.a Event userform aktif Pada bagian userform aktif ada beberapa syrata agar transaksi penambahan stok berjalan 1. Sudah terdapat databse item 2. Sudah ada database supplier Jika kedua database ini kosong atau salah satunya kosong maka transaksi penambahan stok item tidak akan berjalan.
Private Sub UserForm_Activate() Set dtitem = Sheets("DatabaseItem") Set dsupplier = Sheets("DatabaseSupplier") If dtitem.Range("A3").Value = "" Then MsgBox " Tidak ada data dalam database item", _ vbOKOnly, "Databse item kosong" Unload Me Exit Sub ElseIf dsupplier.Range("A3").Value = "" Then MsgBox " Tidak ada data dalam database supplier", _ vbOKOnly, "Databse item supplier" Unload Me irembun.blogspot.com/2015/01/a3.html
2/21
3/20/15
A3 ~ Mata Arjuna
Exit Sub End If Call iTemKode Call PelangganKode Call Headertransaksi tTanggal.Value = Format(Date, " dd mm yyyy ") End Sub
6.3.b Pengisian combobox kode item Sub iTemKode() Set Iparengan = Sheets("DatabaseItem") For
Each
sIparengan
In
Iparengan.Range("KodeItem") With Me.cKode .ColumnCount = 2 .AddItem sIparengan.Value .List(.ListCount - 1, 1) = sIparengan.Offset(0, 1).Value End With Next sIparengan End Sub
6.3.c Pengisian combobox kode supplier Sub PelangganKode() Set Iparengan = Sheets("DatabaseSupplier") For
Each
sIparengan
In
Iparengan.Range("KodeSupplier") With Me.cKodeSupplier .ColumnCount = 2 .AddItem sIparengan.Value .List(.ListCount - 1, 1) = sIparengan.Offset(0, 1).Value End With Next sIparengan End Sub
6.3.d Event pembuatan header transaksi Sub Headertransaksi() ListPemasukan.Clear irembun.blogspot.com/2015/01/a3.html
3/21
3/20/15
A3 ~ Mata Arjuna
With ListPemasukan .AddItem .ColumnCount = 7 .BoundColumn = 7 .List(.ListCount - 1, 0) = "NO" .List(.ListCount - 1, 1) = "KODE" .List(.ListCount - 1, 2) = "NAMA" .List(.ListCount - 1, 3) = "SPECIFIKASI" .List(.ListCount - 1, 4) = "MERK" .List(.ListCount - 1, 5) = "SATUAN" .List(.ListCount - 1, 6) = "QTY" .ColumnWidths = 35 & ";" & 55 & ";" & 80 & ";" & 80 & ";" & 70 & ";" & 60 & ";" & 60 End With End Sub
6.3.e Kolom textbox QTY hany bisa diisi angka 0-9 Private Sub tQty_KeyPress(ByVal KeyAscii _ As MSForms.ReturnInteger) Select Case KeyAscii Case Asc("0") To Asc("9") Case Else KeyAscii = 0 End Select End Sub
6.3.f Event kolom textbox kode item, Membuat lookup database item kedalam kolom nama dan specifikasi
Private Sub cKode_Change() Set dtitem = Sheets("DatabaseItem") Set KeyRangeA = dtitem.Range("KodeItem") Set c = KeyRangeA.Find(cKode.Value, _ LookIn:=xlValues) tNama.Value = c.Offset(0, 1).Value Tspecifikasi.Value = c.Offset(0, 2).Value tQty.SetFocus End Sub
6.3.g Event kolom textbox kode supplier, Membuat irembun.blogspot.com/2015/01/a3.html
4/21
3/20/15
A3 ~ Mata Arjuna
lookup database supplier kedalam kolom nama supplier
Private Sub cKodeSupplier_Change() Set dtSupplier = Sheets("DatabaseSupplier") Set
KeyRangeA
=
dtSupplier.Range("KodeSupplier") Set c = KeyRangeA.Find(cKodeSupplier.Value, _ LookIn:=xlValues) tNamaSupplier.Value = c.Offset(0, 1).Value End Sub
6.3.h Event pada tombol tambah/input, membuat list pada listbox dengan list database item yang masuk Private Sub cmTambah_Click() Set tItemData = Sheets("DatabaseItem") Set rgKodeBrg = tItemData.Range("KodeItem") If tItemData.Range("A3").Value = "" Then Exit Sub End If For CekItem = 1 To ListPemasukan.ListCount 1 If
ListPemasukan.List(CekItem,
1)
=
cKode.Value Then MsgBox " Item " & ListPemasukan.List(CekItem, 2) & _ " sudah ada", vbOKOnly, "Item Barang Sudah Masuk" ListPemasukan.SetFocus ListPemasukan.ListIndex = CekItem Exit Sub End If Next CekItem Set
c
=
rgKodeBrg.Find(cKode.Value,
LookIn:=xlValues) With ListPemasukan .AddItem .List(.ListCount
-
1,
0)
=
ListPemasukan.ListCount - 1 .List(.ListCount - 1, 1) = cKode.Value .List(.ListCount - 1, 2) = tNama.Value .List(.ListCount - 1, 3) = Tspecifikasi.Value irembun.blogspot.com/2015/01/a3.html
5/21
3/20/15
A3 ~ Mata Arjuna
.List(.ListCount - 1, 4) = c.Offset(0, 3).Value .List(.ListCount - 1, 5) = c.Offset(0, 4).Value .List(.ListCount - 1, 6) = tQty.Value End With tQty.Value = "" End Sub
For CekItem = 1 To ListPemasukan.ListCount 1 If
ListPemasukan.List(CekItem,
1)
=
cKode.Value Then ........ Exit Sub End If Next CekItem Kode macro ini berfungsi mencari data yang sama, pada kasus ini mencari data kembar pada listbox pada kolom nomor 1 " kode item " ( ingat kolom pada listbox dimulai dari 0 ), dengan kode ini pula bisa merubah data yang ada pada listbox, contohnya
For CekItem = 1 To ListPemasukan.ListCount 1 If
ListPemasukan.List(CekItem,
1)
=
Textbox1.Value Then ListPemasukan.List(.ListCount
-
1,
2)
=
-
1,
3)
=
Textbox2.Value ListPemasukan.List(.ListCount Textbox3.Value End If Next CekItem Merubah nilai listbox dengan primer key pada kolom 2, logikanya " Jika nilai pada listbox kolom nomor 2 bernilai sama dengan nilai textbox1, maka nilai listbox kolom nomor 3 diganti dengan nilai textbox2, dan nilai pada listbox kolom nomor 4 diganti dengan nilai textbox3 " 6.3.i Event pada tombol hapus list pada listbox dengan irembun.blogspot.com/2015/01/a3.html
6/21
3/20/15
A3 ~ Mata Arjuna
list database item yang masuk Private Sub cmHapus_Click() If ListPemasukan.ListIndex < 1 Then MsgBox "Pilih nomor item yang akan dihapus", _ vbOKOnly, "Pilih Nomor Item" ListPemasukan.SetFocus Exit Sub Else ListPemasukan.RemoveItem (ListPemasukan.ListIndex) End If For NoItem = 1 To ListPemasukan.ListCount - 1 ListPemasukan.List(NoItem, 0) = NoItem Next NoItem End Sub
6.3.j Event pada tombol simpan transaksi penambahan stok item Private Sub cSimpan_Click() Set tItemData = Sheets("DatabaseItem") Set hPmskn = Sheets("HeaderPemasukan") Set dPmskn = Sheets("DatabasePemasukan") If cKodeSupplier.Value = "" Then cKodeSupplier.SetFocus Exit Sub ElseIf tNomor.Value = "" Then tNomor.SetFocus Exit Sub End If If ListPemasukan.ListCount < 2 Then MsgBox "Tidak ada transaksi penambahan stok item", _ vbOKOnly + vbCritical, "Belum Ada Transaksi" Exit Sub End If Set KdItnm = tItemData.Range("KodeItem") SelHdrKsg
=
hPmskn.Cells(hPmskn.Rows.Count, "A"). _ End(xlUp).Offset(0, 0).Row SelDtbsKsg
=
dPmskn.Cells(dPmskn.Rows.Count, "A"). _ irembun.blogspot.com/2015/01/a3.html
7/21
3/20/15
A3 ~ Mata Arjuna
End(xlUp).Offset(0, 0).Row hPmskn.Cells(SelHdrKsg + 1, 1).Value = tNomor hPmskn.Cells(SelHdrKsg
+
1,
2).Value
=
+
1,
3).Value
=
+
1,
4).Value
=
+
1,
5).Value
=
tTanggal.Value hPmskn.Cells(SelHdrKsg cKodeSupplier.Value hPmskn.Cells(SelHdrKsg tNamaSupplier.Value hPmskn.Cells(SelHdrKsg
Sheets("DatabaseUser").Range("E3").Value For No = 1 To ListPemasukan.ListCount - 1 Set c = KdItnm.Find(ListPemasukan.List(No, 1), _ LookIn:=xlValues) c.Offset(0, 5).Value = c.Offset(0, 5).Value + _ ListPemasukan.List(No, 6) dPmskn.Cells(SelDtbsKsg + No, 1).Value = tNomor dPmskn.Cells(SelDtbsKsg + No, 2).Value = tTanggal.Value dPmskn.Cells(SelDtbsKsg + No, 3).Value = cKodeSupplier.Value dPmskn.Cells(SelDtbsKsg + No, 4).Value = tNamaSupplier.Value dPmskn.Cells(SelDtbsKsg + No, 5).Value = _ Sheets("DatabaseUser").Range("E3").Value dPmskn.Cells(SelDtbsKsg + No, 6).Value = _ ListPemasukan.List(No, 0) dPmskn.Cells(SelDtbsKsg + No, 7).Value = _ ListPemasukan.List(No, 1) dPmskn.Cells(SelDtbsKsg + No, 8).Value = _ ListPemasukan.List(No, 2) dPmskn.Cells(SelDtbsKsg + No, 9).Value = _ ListPemasukan.List(No, 3) dPmskn.Cells(SelDtbsKsg + No, 10).Value = _ ListPemasukan.List(No, 4) dPmskn.Cells(SelDtbsKsg + No, 11).Value = _ ListPemasukan.List(No, 5) dPmskn.Cells(SelDtbsKsg + No, 12).Value = _ ListPemasukan.List(No, 6) Next No ThisWorkbook.Save Call UserForm_Activate End Sub irembun.blogspot.com/2015/01/a3.html
8/21
3/20/15
A3 ~ Mata Arjuna
Edit data masal :D, berikut ini cara edit data masal dengan primer key pada range "KodeItem" . Set tItemData = Sheets("DatabaseItem") Set KdItnm = tItemData.Range("KodeItem") Set c = KdItnm.Find(ListPemasukan.List(No, 1), _ LookIn:=xlValues) c.Offset(0, 5).Value = c.Offset(0, 5).Value + _ ListPemasukan.List(No, 6) Logikanya " Jika nilai pada kolom listbox nomor 2 sama dengan nilai pada sheet "databaseitem" range "KodeItem" maka nilai pada kolom F " c.Offset(0, 5).Value " ditambah nilai pada listbok
kolom nomor 7 "
ListPemasukan.List(No, 6) " Seumpama nilai pada kolom F dan kolom listbox nomr 7 adalah bilangan desimal maka kodingnya sedikit berubah menjadi c.Offset(0, 5).Value = Cdbl(c.Offset(0, 5).Value) + Cdbl(ListPemasukan.List(No, 6)) 6.3.k Event pada tombol baru Private Sub cBaru_Click() Call UserForm_Activate End Sub
6.3.k Event pada tombol keluar Private Sub cmKeluar_Click() Unload Me End Sub Untuk keterangan kode macro yang belum pernah dibahas akan diterangkan pada bagian akhir setalah selesai pembuatan transaksi pengurangan stok item (Pengeluaran). 7. MEMBUAT TRANSAKSI PENGURANGAN STOK ITEM (PENGELUARAN) 7.1 Header pengurangan stok iten irembun.blogspot.com/2015/01/a3.html
9/21
3/20/15
A3 ~ Mata Arjuna
Header digunakan sebagai data bantu untuk database pengurangan stok item, pada field headr pengurangan stok item terdiri dari NOMOR TRANSAKSI TANGGAL TRANSAKSI KODE PELANGGAN dan NAMA PELANGGAN dan YANG TERAKHIR NAMA USER Tidak ada koding pada bagian header pengurangan stok item ini. 7.2 Database pengurangan stok item Database pengurangan stok item memuat informasi dengan mengacu pada header pengurangan stok item, pada fiel database penambahn stok item terdiri dari NOMOR TRANSAKSI TANGGAL TRANSAKSI KODE PELANGGAN dan NAMA PELANGGAN NAMA USER NOMOR URUT ITEM KODE ITEM NAMA ITEM SPECIFIKASI ITEM MERK ITEM SATUAN ITEM dan JUMLAH keluar STOK ITEM Untu lebih jelasnya silahkan buka Folder IPA-2 file APG6 Buka
sheet
HeaderPengeluaran
dan
DatabasePengeluaran keluar kejendela visual basic editor, temukan desig userform "FormPengeluaran" 7.2.a Design userform pengurangan stok item
irembun.blogspot.com/2015/01/a3.html
10/21
3/20/15
A3 ~ Mata Arjuna
7.3 Ngoding userform pengurangan stok item 7.3.a Event userform aktif Pada bagian userform aktif ada beberapa syrata agar transaksi pengurangan stok berjalan 1. Sudah terdapat databse item 2. Sudah ada database Pelanggan Jika kedua database ini kosong atau salah satunya kosong maka transaksi pengurangan stok item tidak akan berjalan.
Private Sub UserForm_Activate() Set dtitem = Sheets("DatabaseItem") Set
dPelanggan
=
Sheets("DatabasePelanggan") If dtitem.Range("A3").Value = "" Then MsgBox " Tidak ada data dalam database item", _ vbOKOnly, "Databse item kosong" Unload Me Exit Sub ElseIf dPelanggan.Range("A3").Value = "" Then MsgBox " Tidak ada data dalam database Pelanggan", _ vbOKOnly, "Databse item Pelanggan" irembun.blogspot.com/2015/01/a3.html
11/21
3/20/15
A3 ~ Mata Arjuna
Unload Me Exit Sub End If Call iTemKode Call PelangganKode Call Headertransaksi tTanggal.Value = Format(Date, " dd mm yyyy ") End Sub
7.3.b Pengisian combobox kode item Sub iTemKode() Set Iparengan = Sheets("DatabaseItem") For
Each
sIparengan
In
Iparengan.Range("KodeItem") With Me.cKode .ColumnCount = 2 .AddItem sIparengan.Value .List(.ListCount - 1, 1) = sIparengan.Offset(0, 1).Value End With Next sIparengan End Sub
7.3.c Pengisian combobox kode Pelanggan Sub PelangganKode() Set Iparengan = Sheets("DatabasePelanggan") For
Each
sIparengan
In
Iparengan.Range("KodePelanggan") With Me.cKodePelanggan .ColumnCount = 2 .AddItem sIparengan.Value .List(.ListCount - 1, 1) = sIparengan.Offset(0, 1).Value End With Next sIparengan End Sub
7.3.d Event pembuatan header transaksi Sub Headertransaksi() irembun.blogspot.com/2015/01/a3.html
12/21
3/20/15
A3 ~ Mata Arjuna
ListPengeluaran.Clear With ListPengeluaran .AddItem .ColumnCount = 7 .BoundColumn = 7 .List(.ListCount - 1, 0) = "NO" .List(.ListCount - 1, 1) = "KODE" .List(.ListCount - 1, 2) = "NAMA" .List(.ListCount - 1, 3) = "SPECIFIKASI" .List(.ListCount - 1, 4) = "MERK" .List(.ListCount - 1, 5) = "SATUAN" .List(.ListCount - 1, 6) = "QTY" .ColumnWidths = 35 & ";" & 55 & ";" & 80 & ";" & 80 & ";" & 70 & ";" & 60 & ";" & 60 End With End Sub
7.3.e Kolom textbox QTY hany bisa diisi angka 0-9 Private Sub tQty_KeyPress(ByVal KeyAscii _ As MSForms.ReturnInteger) Select Case KeyAscii Case Asc("0") To Asc("9") Case Else KeyAscii = 0 End Select End Sub
7.3.f Event kolom textbox kode item, Membuat lookup database item kedalam kolom nama dan specifikasi Private Sub cKode_Change() Set dtitem = Sheets("DatabaseItem") Set KeyRangeA = dtitem.Range("KodeItem") Set c = KeyRangeA.Find(cKode.Value, _ LookIn:=xlValues) tNama.Value = c.Offset(0, 1).Value Tspecifikasi.Value = c.Offset(0, 2).Value tQty.SetFocus End Sub
7.3.g Event kolom textbox kode Pelanggan, Membuat irembun.blogspot.com/2015/01/a3.html
13/21
3/20/15
A3 ~ Mata Arjuna
lookup database Pelanggan kedalam kolom nama Pelanggan Private Sub cKodePelanggan_Change() Set
dtPelanggan
=
Sheets("DatabasePelanggan") Set
KeyRangeA
=
dtPelanggan.Range("KodePelanggan") Set
c
=
KeyRangeA.Find(cKodePelanggan.Value, _ LookIn:=xlValues) tNamaPelanggan.Value = c.Offset(0, 1).Value End Sub
7.3.h Event pada tombol tambah/input, membuat list pada listbox dengan list database item yang keluar Private Sub cmTambah_Click() Set tItemData = Sheets("DatabaseItem") Set rgKodeBrg = tItemData.Range("KodeItem") If tItemData.Range("A3").Value = "" Then Exit Sub End If For CekItem = 1 To ListPengeluaran.ListCount 1 If
ListPengeluaran.List(CekItem,
1)
=
cKode.Value Then MsgBox
"
Item
"
&
ListPengeluaran.List(CekItem, 2) & _ " sudah ada", vbOKOnly, "Item Barang Sudah Masuk" ListPengeluaran.SetFocus ListPengeluaran.ListIndex = CekItem Exit Sub End If Next CekItem Set
c
=
rgKodeBrg.Find(cKode.Value,
LookIn:=xlValues) CekStok = c.Offset(0, 5).Value - tQty.Value If CekStok < 0 Then MsgBox "Stok " & tNama.Value & " yang tersedia " _ & c.Offset(0, 5).Value, vbOKOnly, "Stok Barang irembun.blogspot.com/2015/01/a3.html
14/21
3/20/15
A3 ~ Mata Arjuna
Tidak Ada" tQty.Value = "" tQty.SetFocus Exit Sub End If With ListPengeluaran .AddItem .List(.ListCount
-
1,
0)
=
ListPengeluaran.ListCount - 1 .List(.ListCount - 1, 1) = cKode.Value .List(.ListCount - 1, 2) = tNama.Value .List(.ListCount - 1, 3) = Tspecifikasi.Value .List(.ListCount - 1, 4) = c.Offset(0, 3).Value .List(.ListCount - 1, 5) = c.Offset(0, 4).Value .List(.ListCount - 1, 6) = tQty.Value End With tQty.Value = "" End Sub
Sedikit perbedaan pada event pengeluaran item dengan pemasukan item, jika pada pemasukan item tidak terdapat cek stok item, maka pada pengeluaran item terdapat cek item stok. Cek item stok dilakukan agar tidak terjadi minus stok item dalam database item. Set tItemData = Sheets("DatabaseItem") 'Primare key pada range "kodeItem" Set rgKodeBrg = tItemData.Range("KodeItem") 'Pencarian nilai primer key pada range "KodeItem" yang sesuai dengan nilai textbox "cKode" Set c = rgKodeBrg.Find(cKode.Value, LookIn:=xlValues) 'Cekstok adalah nilai pada sheet "DatabaseItem" kolom F dikurangi nilai textbox "tQty" CekStok = c.Offset(0, 5).Value - tQty.Value 'Cekstok tidak boleh bernilai kurag dari "0", jika nilai kurang dari "0" maka keluar dari prosedur If CekStok < 0 Then MsgBox "Stok " & tNama.Value & " yang tersedia " _ & c.Offset(0, 5).Value, vbOKOnly, "Stok Barang Tidak Ada" tQty.Value = "" irembun.blogspot.com/2015/01/a3.html
15/21
3/20/15
A3 ~ Mata Arjuna
tQty.SetFocus Exit Sub End If
7.3.i Event pada tombol hapus list pada listbox dengan list database item yang keluar Private Sub cmHapus_Click() If ListPengeluaran.ListIndex < 1 Then MsgBox "Pilih nomor item yang akan dihapus", _ vbOKOnly, "Pilih Nomor Item" ListPengeluaran.SetFocus Exit Sub Else ListPengeluaran.RemoveItem (ListPengeluaran.ListIndex) End If For NoItem = 1 To ListPengeluaran.ListCount 1 ListPengeluaran.List(NoItem, 0) = NoItem Next NoItem End Sub
7.3.j
Event
pada
tombol
simpan
transaksi
pengurangan stok item Private Sub cSimpan_Click() Set tItemData = Sheets("DatabaseItem") Set hPmskn = Sheets("HeaderPengeluaran") Set dPmskn = Sheets("DatabasePengeluaran") If cKodePelanggan.Value = "" Then cKodePelanggan.SetFocus Exit Sub ElseIf tNomor.Value = "" Then tNomor.SetFocus Exit Sub End If If ListPengeluaran.ListCount < 2 Then MsgBox "Tidak ada transaksi pengurangan stok item", _ vbOKOnly + vbCritical, "Belum Ada Transaksi" irembun.blogspot.com/2015/01/a3.html
16/21
3/20/15
A3 ~ Mata Arjuna
Exit Sub End If Set KdItnm = tItemData.Range("KodeItem") SelHdrKsg
=
hPmskn.Cells(hPmskn.Rows.Count, "A"). _ End(xlUp).Offset(0, 0).Row SelDtbsKsg
=
dPmskn.Cells(dPmskn.Rows.Count, "A"). _ End(xlUp).Offset(0, 0).Row hPmskn.Cells(SelHdrKsg + 1, 1).Value = tNomor hPmskn.Cells(SelHdrKsg
+
1,
2).Value
=
+
1,
3).Value
=
+
1,
4).Value
=
+
1,
5).Value
=
tTanggal.Value hPmskn.Cells(SelHdrKsg cKodePelanggan.Value hPmskn.Cells(SelHdrKsg tNamaPelanggan.Value hPmskn.Cells(SelHdrKsg
Sheets("DatabaseUser").Range("E3").Value For No = 1 To ListPengeluaran.ListCount - 1 Set c = KdItnm.Find(ListPengeluaran.List(No, 1), _ LookIn:=xlValues) c.Offset(0, 5).Value = c.Offset(0, 5).Value - _ ListPengeluaran.List(No, 6) dPmskn.Cells(SelDtbsKsg + No, 1).Value = tNomor dPmskn.Cells(SelDtbsKsg + No, 2).Value = tTanggal.Value dPmskn.Cells(SelDtbsKsg + No, 3).Value = cKodePelanggan.Value dPmskn.Cells(SelDtbsKsg + No, 4).Value = tNamaPelanggan.Value dPmskn.Cells(SelDtbsKsg + No, 5).Value = _ Sheets("DatabaseUser").Range("E3").Value dPmskn.Cells(SelDtbsKsg + No, 6).Value = _ ListPengeluaran.List(No, 0) dPmskn.Cells(SelDtbsKsg + No, 7).Value = _ ListPengeluaran.List(No, 1) dPmskn.Cells(SelDtbsKsg + No, 8).Value = _ ListPengeluaran.List(No, 2) dPmskn.Cells(SelDtbsKsg + No, 9).Value = _ ListPengeluaran.List(No, 3) dPmskn.Cells(SelDtbsKsg + No, 10).Value = _ ListPengeluaran.List(No, 4) irembun.blogspot.com/2015/01/a3.html
17/21
3/20/15
A3 ~ Mata Arjuna
dPmskn.Cells(SelDtbsKsg + No, 11).Value = _ ListPengeluaran.List(No, 5) dPmskn.Cells(SelDtbsKsg + No, 12).Value = _ ListPengeluaran.List(No, 6) Next No ThisWorkbook.Save Call UserForm_Activate End Sub
7.3.k Event pada tombol baru Private Sub cBaru_Click() Call UserForm_Activate End Sub
7.3.k Event pada tombol keluar Private Sub cmKeluar_Click() Unload Me End Sub
Membuat form cetak untuk membuat cetakan pada masing masing database 8.1 Membuat form cetak database item Buka File APG-7 Cetak databse item mempunyai dua opsi, opsi pertama cetak seluruh databse item, opsi kedua cetak databse item yang mempunyai stok dibawah item dibawah 5 . Berikut ini adalah koding yang dipakai dalam membuat form cetak database item
irembun.blogspot.com/2015/01/a3.html
18/21
3/20/15
A3 ~ Mata Arjuna
8.1.a Koding tombol cetak Private Sub cmdCetak_Click() Set sDtbnt = Sheets("DatabaseUser") Set sDtiTem = Sheets("DatabaseItem") Set dCtk = Sheets("Cetak") Set fltrKrt = sDtiTem.Range("O2:Q3") dCtk.PageSetup.Orientation = xlLandscape dCtk.PageSetup.PrintArea = "$A:$F" dCtk.Cells.Clear dCtk.Columns("A:A").ColumnWidth = 10 dCtk.Rows("7:7").RowHeight = 5 dCtk.Range("A1").Value
=
sDtbnt.Range("J3").Value dCtk.Range("A2").Value
=
sDtbnt.Range("K3").Value _ & " " & sDtbnt.Range("L3").Value & " " & sDtbnt.Range("M3").Value dCtk.Range("A4").Value = "DATABASE ITEM" If Oall.Value = True Then dCtk.Range("A5").Value = "Cetak : Seluruh databse" sDtiTem.Range("O3:Q3").ClearContents ElseIf oMin.Value = True Then dCtk.Range("A5").Value = "Cetak : Stok minimal" irembun.blogspot.com/2015/01/a3.html
19/21
3/20/15
A3 ~ Mata Arjuna
sDtiTem.Range("O3:Q3").ClearContents sDtiTem.Range("Q3").Value = "<5" End If dCtk.Range("A7").Font.Bold = True sDtiTem.Range("A2:F2").Copy dCtk.Range("A8").PasteSpecial Paste:=xlPasteColumnWidths sDtiTem.Range("DatabaseItem").AdvancedFilter _ Action:=xlFilterInPlace, CriteriaRange:=fltrKrt sDtiTem.Range("DatabaseItem").SpecialCells _ (xlCellTypeVisible).Copy Destination:=dCtk.Range("A8") dCtk.PrintOut Copies:=1, Collate:=True If sDtiTem.FilterMode Then sDtiTem.ShowAllData End If End Sub Private Sub cmdKeluar_Click() Unload Me End Sub
If Oall.Value = True Then dCtk.Range("A6").Value =
"Cetak : Seluruh
databse" sDtiTem.Range("O3:Q3").ClearContents ElseIf oMin.Value = True Then dCtk.Range("A6").Value = "Cetak : Stok minimal" sDtiTem.Range("O3:Q3").ClearContents sDtiTem.Range("Q3").Value = "<5 data-bloggerescaped-div=""
data-blogger-escaped-end=""
data-blogger-escaped-if=""> Jika
yang
dipilih
merupakan
optinbutton
Seluruh database maka databse item akan dicetak seluruhnya, dan jika yang dipilih adalah optionbutton stok minimal maka yang dicetak adalah databse item yang stok itemnya dibawah 5 pcs Jika anda menghendaki stok minimal adalah 2 maka ganti kode "sDtiTem.Range("Q3").Value = " irembun.blogspot.com/2015/01/a3.html
20/21
3/20/15
A3 ~ Mata Arjuna
<5 data-blogger-escaped-8.1.b="" data-bloggerescaped-alue="<2" data-blogger-escaped-div="" data-blogger-escaped-keluar=""
data-blogger-
escaped-koding=""
data-blogger-escaped-
menjadi=""
data-blogger-escaped-
sdtitem.range=""
data-blogger-escaped-
tombol="" style="border-top: 1px solid #f48067; float: left; margin: 4px 0px 5px 0px; padding: 1px 0px; width: 100%;">
Private Sub cmdKeluar_Click() Unload Me End Sub
irembun.blogspot.com/2015/01/a3.html
21/21
