Otomatisasi Sistem Informasi Pembelian Kebutuhan ......Private Sub cmdtambah_Click() Dim brsakhr...
Transcript of Otomatisasi Sistem Informasi Pembelian Kebutuhan ......Private Sub cmdtambah_Click() Dim brsakhr...
52
LAMPIRAN
1. Lampiran Utama
a. Struktur Organisasi Perusahaan
Mill Head
Sekretaris MBOS
Production HeadPurchasing
Head
Finance & Mill
Service HeadBusiness Head
Sales Unit
Head
MTC & Utility
Unit Head
Carton Box/
Finishing Unit
Head
Carton Sheet
Unit Head
IT Unit Head
HR & GA Unit
Head
Finance Unit
Head
Accounting
Head
QC Unit Head
PPIC Unit Head
Inner Sales
Head
Paper Tube
Unit Head
Logistik Head
53
b. Flowchart Pembelian Kebutuhan Stationery
Surat
Jalan
2
PT PURINUSA EKAPERSADA
PROSEDUR PEMBELIAN KEBUTUHAN STATIONERY
ANALYTIC FLOWCHART
BAGIAN PEMBELIAN BAGIAN GUDANG
Menerima Form
Kebutuhan Stationery
dari setiap Bagian
Form Kebutuhan
Stationery
Rekap
Stationery
sesuai anggaran
tidak ?
Mengecek
anggaran
setiap bagian
Tidak
Ya
Melakukan
konfirmasi ke
bagian
Form
Kebutuhan
Stationery
Form
Kebutuhan
Stationery
Penawaran
Harga
Pemasok
Penawaran
Harga
Penawaran
Harga
Penawaran
Harga
Rekap
Stationery
Pemasok
Surat
Jalan
1
Mengecek
Kesesuaian,
menandatangani
dan memberi
cap
Surat
Jalan
1 Surat
Jalan
2
Pemasok
Pemasok telah
mengisi harga &
menandatangani
KwitansiNota
Penjualan
Surat
Jalan
1
Pemasok
1
Merekap
Kebutuhan
Stationery
Membuat
Penawaran
Harga
Mengisi harga di
Rekap Stationery
dan Membuat POPurchase
Order
Purchase
Order
Form
Kebutuhan
Stationery
Purchase
Order
54
1
PT PURINUSA EKAPERSADA
PROSEDUR PEMBELIAN KEBUTUHAN STATIONERY
ANALYTIC FLOWCHART
BAGIAN PEMBELIAN
KwitansiNota
Penjualan
Surat
Jalan
1
Membuat
Tanda Terima
dan
ditandatangani
Tanda
TerimaKwitansi
Nota
Penjualan
Surat
Jalan
1
Pemasok
Mencetak
Rekap
Stationery
Rekap
Stationery
1
2
2
BAGIAN GUDANG
Setiap
Bagian
BAGIAN AKUNTING
1
Mengecek
kesesuaian,
dan Membuat
Voucher
Voucher
3
KASIR
3
Voucher
Bank
Menstransfer
uang
pembayaran ke
rekening
Pemasok
Membuat
Laporan
Pembayaran
Laporan
Pembayaran
Bukti
PembayaranVoucher
T
Memberikan
Cap Lunas
Voucher
4
4
Purchase
Order
Selesai
Form
Kebutuhan
Stationery
Rekap
Stationery
2
Form
Kebutuhan
Stationery
Rekap
Stationery
2
Rekap
stationery
1Kwitansi
Nota
Penjualan
Surat
Jalan
1
Purchase
OrderPenawaran
Harga
Rekap
stationery
1Kwitansi
Nota
Penjualan
Surat
Jalan
1
Purchase
OrderPenawaran
Harga
Rekap
stationery
1Kwitansi
Nota
Penjualan
Surat
Jalan
1
Purchase
OrderPenawaran
Harga
Rekap
stationery
1Kwitansi
Nota
Penjualan
Surat
Jalan
1
Purchase
OrderPenawaran
Harga
Rekap
stationery
1Kwitansi
Nota
Penjualan
Surat
Jalan
1
Purchase
OrderPenawaran
Harga
Rekap
stationery
1Kwitansi
Nota
Penjualan
Surat
Jalan
1
Purchase
OrderPenawaran
Harga
Rekap
stationery
1Kwitansi
Nota
Penjualan
Surat
Jalan
1
Purchase
OrderPenawaran
Harga
Voucher
55
c. Coding List
Kode menjalankan Form Menu Utama
Private Sub Cmddatabarang_Click() frmMenuUtama.Hide
frmdatabarang.Show
End Sub
Private Sub Cmddatauser_Click()
frmMenuUtama.Hide
frmdatauser.Show
End Sub
Private Sub cmdisipermintaanbrg_Click()
frmMenuUtama.Hide
frmInputPermintaan.Show
End Sub
Private Sub cmdctkpnwran_Click()
Sheets("PENAWARAN HARGA").Select
Range("A1:D88").Select
Call setprint
Sheets("PENAWARAN HARGA").PrintOut
End Sub
Private Sub cmdisiharga_Click()
frmMenuUtama.Hide
frminputharga.Show
End Sub
Private Sub cmdctkpo_Click()
Sheets("PURCHASE ORDER").Select
Call setprint2
Sheets("PURCHASE ORDER").PrintOut
End Sub
Private Sub cmdinputbrgmsk_Click()
frmMenuUtama.Hide
frminputbarangmasuk.Show
End Sub
Private Sub cmdkeluar_Click()
Unload Me
'perintah untuk keluar dari Excel
End Sub
Kode menjalankan Form Data Barang
Private Sub cmdedit_Click()
Sheets("Databarang").Select
brssedit = Me.txtno + 3
Cells(brssedit, 1).Select
'ActiveCell.Value = Me.txtno
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.txtbrg
End Sub
Private Sub cmdtambah_Click()
Dim brsakhr
'tanya apakah data no sudah ada
Sheets("Databarang").Select
x = 4
Do Until Cells(x, 1) = isblank
Cells(x, 1).Select
x = x + 1
Loop
brsakhr = x - 1
brsakhr2 = x - 2
56
Cells(brsakhr2, 1).Select
no = ActiveCell.Value
Cells(brsakhr, 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = no + 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.txtbrg
Sheets("rekap").Select
x = 4
Do Until Cells(x, 1) = isblank
Cells(x, 1).Select
x = x + 1
Loop
brsakhr = x - 1
brsakhr2 = x - 2
Cells(brsakhr2, 1).Select
no = ActiveCell.Value
Cells(brsakhr, 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = no + 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.txtbrg
Sheets("PENAWARAN HARGA").Select
x = 16
Do Until Cells(x, 1) = isblank
Cells(x, 1).Select
x = x + 1
Loop
brsakhr = x - 1
brsakhr2 = x - 2
Cells(brsakhr2, 1).Select
no = ActiveCell.Value
Cells(brsakhr, 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = no + 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.txtbrg
Sheets("PURCHASE ORDER").Select
x = 16
Do Until Cells(x, 3) = isblank
Cells(x, 3).Select
x = x + 1
Loop
brsakhr = x - 1
brsakhr2 = x - 2
Cells(brsakhr2, 3).Select
no = ActiveCell.Value
Cells(brsakhr, 3).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = no + 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.txtbrg
Sheets("Label").Select
x = 6
Do Until Cells(x, 3) = isblank
Cells(x, 3).Select
x = x + 1
Loop
57
brsakhr = x - 1
brsakhr2 = x - 2
Cells(brsakhr2, 3).Select
no = ActiveCell.Value
Cells(brsakhr, 3).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = no + 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Me.txtbrg
End Sub
Private Sub cmdkeluar_Click()
frmdatabarang.Hide
frmMenuUtama.Show
End Sub
Private Sub lstviewbrg_Click()
Me.txtno.Value = lstviewbrg.List(, 0)
Me.txtbrg.Value = lstviewbrg.List(, 1)
Sheets("Databarang").Select
Cells.Find(What:=Me.txtbrg.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
brss = ActiveCell.Row
End Sub
Private Sub UserForm_Activate()
Sheets("Databarang").Select
lstviewbrg.ColumnCount = 2
With lstviewbrg
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Barang"
.ColumnWidths = 35 & ";" & 70
End With
x = 4
Do Until Cells(x, 1) = isblank
Cells(x, 1).Select
With lstviewbrg
.AddItem
.List(.ListCount - 1, 0) = Cells(x, 1).Value
.List(.ListCount - 1, 1) = Cells(x, 2).Value
End With
x = x + 1
Loop
End Sub
Kode menjalankan Form Data User
Private Sub cmdtambah_Click()
'Dim brsakhr
'tanya apakah data no sudah ada
Sheets("rekap").Select
Range("A1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
nomerkolom1 = ActiveCell.Value + 1
nomerkolom2 = ActiveCell.Value + 2
ActiveCell.Offset(0, 1).Select
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = nomerkolom1
ActiveCell.Offset(0, 1).Select
58
ActiveCell.Value = nomerkolom2
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = Me.txtuser
alm1 = ActiveCell.Address
ActiveCell.Offset(1, 1).Select
alm2 = ActiveCell.Address
Range(alm1 & ":" & alm2).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Sheets("user").Select
Range("A21").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Me.txtuser
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = nomerkolom1
End Sub
Private Sub cmdkeluar_Click()
frmdatauser.Hide
59
frmMenuUtama.Show
End Sub
Private Sub cmdedit_Click()
Sheets("user").Select
brssedit = Me.txtuser
ActiveCell.Value = Me.txtuser
ActiveCell.Value = Me.txtuser
Sheets("rekap").Select
kolom = Me.txtklm.Value
Range("A1").Select
ActiveCell.Offset(0, kolom).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Me.txtuser
Sheets("user").Select
End Sub
Private Sub Lstviewuser_Click()
Me.txtuser.Value = Lstviewuser.List(, 0)
Me.txtklm.Value = Lstviewuser.List(, 1)
Sheets("user").Select
Cells.Find(What:=Me.txtuser.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
brss = ActiveCell.Row
End Sub
Private Sub UserForm_Activate()
Sheets("user").Select
Lstviewuser.ColumnCount = 2
With Lstviewuser
.AddItem
.List(.ListCount - 1, 0) = "Nama Bagian"
.List(.ListCount - 1, 1) = "Nilai Kolom"
.ColumnWidths = 70 & ";" & 70
End With
x = 2
Do Until Cells(x, 1) = isblank
Cells(x, 1).Select
With Lstviewuser
.AddItem
.List(.ListCount - 1, 0) = Cells(x, 1).Value
.List(.ListCount - 1, 1) = Cells(x, 2).Value
End With
x = x + 1
Loop
End Sub
Kode menjalankan Form Input Permintaan Barang
Private Sub cmdinput_Click()
Sheets("Rekap").Select
Bagian = cbouser.Value
namabarang = cbonamabrg.Value
Cells.Find(What:=namabarang, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
brss = ActiveCell.Row
'MsgBox brs
Sheets("user").Select
Cells.Find(What:=Bagian, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
60
ActiveCell.Offset(0, 1).Select
kol = ActiveCell.Value
'MsgBox kol
'MsgBox brss
Sheets("Rekap").Select
Cells(brss, kol).Select
ActiveCell.Value = Me.txtjum
'isi untuk listbox
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = Me.cbouser.Value
.List(.ListCount - 1, 1) = Me.cbonamabrg.Value
.List(.ListCount - 1, 2) = Me.txtjum.Value
End With
End Sub
Private Sub cmdkeluar_Click()
frmInputPermintaan.Hide
frmMenuUtama.Show
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "MAKE TOMBOL ATUH KANG!"
End If
End Sub
Private Sub UserForm_Activate()
Sheets("user").Select
x = 2
Do Until Cells(x, 1) = isblank
With Me.cbouser
.AddItem Cells(x, 1).Value
End With
x = x + 1
Loop
Sheets("Databarang").Select
y = 4
Do Until Cells(y, 1) = isblank
With Me.cbonamabrg
.AddItem Cells(y, 2).Value
End With
y = y + 1
Loop
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3
With Me.ListBox1
.AddItem
.List(.ListCount - 1, 0) = "Nama Bagian"
.List(.ListCount - 1, 1) = "Nama Barang"
.List(.ListCount - 1, 2) = "Jumlah"
.ColumnWidths = 60 & ";" & 200
End With
jwb = MsgBox("Apakah Mau Mengisi Form Permintaan Pembelian Baru?", vbYesNo)
If jwb = vbNo Then
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3
With Me.ListBox1
61
.AddItem
.List(.ListCount - 1, 0) = "Nama Barang"
.List(.ListCount - 1, 1) = ""
.List(.ListCount - 1, 2) = ""
.ColumnWidths = 60 & ";" & 200
End With
Sheets("Rekap").Select
Z = 4
Do Until Cells(Z, 1) = isblank
Cells(Z, 1).Select
With Me.ListBox1
.AddItem
.List(.ListCount - 1, 0) = Cells(Z, 2).Value
'isi dengan nama user
.List(.ListCount - 1, 1) = Cells(Z, 3).Value
End With
Z = Z + 1
Loop
Exit Sub
Else
bln = InputBox("isikan Bulan ")
thn = InputBox("isikan Tahun")
End If
Sheets("Rekap").Select
Range("B1").Value = "Bulan : " & bln & " " & thn
'Menghapus isi jumlah
Range("C4:C62").Select
Selection.ClearContents
Range("e4:e62").Select
Selection.ClearContents
Range("g4:g62").Select
Selection.ClearContents
Range("i4:i62").Select
Selection.ClearContents
Range("k4:k62").Select
Selection.ClearContents
Range("m4:m62").Select
Selection.ClearContents
Range("o4:o62").Select
Selection.ClearContents
Range("Q4:Q62").Select
Selection.ClearContents
Range("s4:s62").Select
Selection.ClearContents
Range("u4:w62").Select
Selection.ClearContents
Range("w4:w62").Select
Selection.ClearContents
Range("y4:y62").Select
Selection.ClearContents
Range("aa4:aa62").Select
Selection.ClearContents
Range("AC4:AC62").Select
Selection.ClearContents
Range("AE4:AE62").Select
Selection.ClearContents
Range("AG4:AG62").Select
Selection.ClearContents
Range("AI4:AI62").Select
Selection.ClearContents
Range("AK4:AK62").Select
Selection.ClearContents
Range("AM4:AM62").Select
Selection.ClearContents
Range("AO4:AO62").Select
Selection.ClearContents
Range("AQ4:AQ62").Select
62
Selection.ClearContents
End Sub
Kode menjalankan Form Input Harga
Private Sub cmdinput_Click()
Sheets("PENAWARAN HARGA").Select
namabarang = cbobrg.Value
Cells.Find(What:=namabarang, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
brss = ActiveCell.Row
Cells(brss, 4).Select
ActiveCell.Value = Me.txtharga
'isi di list
Me.lstph.Clear
Sheets("PENAWARAN HARGA").Select
lstph.ColumnCount = 3
With lstph
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Barang"
.List(.ListCount - 1, 2) = "Harga"
.ColumnWidths = 35 & ";" & 200
End With
x = 16
Do Until Cells(x, 1) = isblank
Cells(x, 1).Select
With lstph
.AddItem
.List(.ListCount - 1, 0) = Cells(x, 1).Value
.List(.ListCount - 1, 1) = Cells(x, 2).Value
.List(.ListCount - 1, 2) = Cells(x, 4).Value
End With
x = x + 1
Loop
brs = x
End Sub
Private Sub cmdkeluar_Click()
frminputharga.Hide
frmMenuUtama.Show
End Sub
Private Sub lstph_Click()
Me.cbobrg.Value = Me.lstph.List(, 1)
End Sub
Private Sub UserForm_Activate()
Sheets("PENAWARAN HARGA").Select
lstph.ColumnCount = 3
With lstph
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Barang"
.List(.ListCount - 1, 2) = "Harga"
.ColumnWidths = 35 & ";" & 200
End With
x = 16
Do Until Cells(x, 1) = isblank
Cells(x, 1).Select
With lstph
63
.AddItem
.List(.ListCount - 1, 0) = Cells(x, 1).Value
.List(.ListCount - 1, 1) = Cells(x, 2).Value
.List(.ListCount - 1, 2) = Cells(x, 4).Value
End With
x = x + 1
Loop
brs = x
Range("b10").Select
x = 1
Do Until Cells(x, 2) = isblank
MsgBox Cells(x, 2)
x = x + 1
Loop
End Sub
Kode menjalankan Form Input Barang Masuk
Private Sub cmdinput_Click()
Sheets("PURCHASE ORDER").Select
namabarang = cbobrg.Value
Cells.Find(What:=namabarang, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
brss = ActiveCell.Row
Cells(brss, 8).Select
ActiveCell.Value = Me.txtharga
'isi di list
Me.lstph.Clear
Sheets("PURCHASE ORDER").Select
lstph.ColumnCount = 5
With lstph
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Barang"
.List(.ListCount - 1, 2) = "Jumlah Barang"
.List(.ListCount - 1, 3) = "Harga"
.List(.ListCount - 1, 4) = "Jumlah Barang Masuk"
.ColumnWidths = 35 & ";" & 200
End With
x = 16
Do Until Cells(x, 3) = isblank
Cells(x, 3).Select
With lstph
.AddItem
.List(.ListCount - 1, 0) = Cells(x, 3).Value
.List(.ListCount - 1, 1) = Cells(x, 4).Value
.List(.ListCount - 1, 2) = Cells(x, 5).Value
.List(.ListCount - 1, 3) = Cells(x, 6).Value
.List(.ListCount - 1, 4) = Cells(x, 8).Value
End With
x = x + 1
Loop
brs = x
End Sub
64
Private Sub cmdkeluar_Click()
frminputbarangmasuk.Hide
frmMenuUtama.Show
End Sub
Private Sub lstph_Click()
Me.cbobrg.Value = Me.lstph.List(, 1)
End Sub
Private Sub UserForm_Activate()
Sheets("PURCHASE ORDER").Select
lstph.ColumnCount = 5
With lstph
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Barang"
.List(.ListCount - 1, 2) = "Jumlah Barang"
.List(.ListCount - 1, 3) = "Harga"
.List(.ListCount - 1, 4) = "Jumlah Barang Masuk"
.ColumnWidths = 35 & ";" & 200
End With
x = 16
Do Until Cells(x, 3) = isblank
Cells(x, 3).Select
With lstph
.AddItem
.List(.ListCount - 1, 0) = Cells(x, 3).Value
.List(.ListCount - 1, 1) = Cells(x, 4).Value
.List(.ListCount - 1, 2) = Cells(x, 5).Value
.List(.ListCount - 1, 3) = Cells(x, 6).Value
.List(.ListCount - 1, 4) = Cells(x, 8).Value
End With
x = x + 1
Loop
brs = x
Range("c16").Select
x = 1
Do Until Cells(x, 2) = isblank
MsgBox Cells(x, 2)
x = x + 1
Loop
End Sub
65
d. Dokumen atau Formulir
1. Form Kebutuhan Stationery
66
2. Kwitansi
67
3. Nota Penjualan
68
4. Penawaran Harga
69
70
5. Purchase Order
71
72
6. Rekap Stationery
73
7. Surat Jalan
74
8. Tanda Terima
75
2. Lampiran Pendukung
a. Surat Keterangan Prakek Kerja
76
b. Rekapitulasi Kehadiran Praktek Kerja
77
c. Jurnal Praktek Kerja
78
79
d. Jurnal Bimbingan Tugas Akhir