CODING BARANG BAIK
Option Explicit
Private Sub CMDADD_Click()
Dim DBBARANGBAIK As Object
Set DBBARANGBAIK = Sheet3.Range("A200000").End(xlUp)
If Me.TXTIDINV.Value = "" _
Or Me.TXTNAMA.Value = "" _
Or Me.CMBJENIS.Value = "" _
Or Me.CMBSATUAN.Value = "" _
Or Me.CMBRUANG.Value = "" _
Or Me.TXTJUMLAHBAIK.Value = "" Then
Call MsgBox("Harap isi data barang dengan lengkap", vbInformation, "Data Barang")
Else
DBBARANGBAIK.Offset(1, 0).Value = "=ROW()-ROW($A$4)"
DBBARANGBAIK.Offset(1, 1).Value = Me.TXTIDINV.Value
DBBARANGBAIK.Offset(1, 2).Value = Me.TXTNAMA.Value
DBBARANGBAIK.Offset(1, 3).Value = Me.TXTDESKRIPSI.Value
DBBARANGBAIK.Offset(1, 4).Value = Me.CMBJENIS.Value
DBBARANGBAIK.Offset(1, 5).Value = Me.CMBSATUAN.Value
DBBARANGBAIK.Offset(1, 6).Value = Me.CMBRUANG.Value
DBBARANGBAIK.Offset(1, 7).Value = Me.TXTJUMLAHBAIK.Value
Call AmbilBarangBaik
Call MsgBox("Data Sales berhasil ditambah", vbInformation, "Sales")
Me.TXTIDINV.Value = ""
Me.TXTNAMA.Value = ""
Me.TXTDESKRIPSI.Value = ""
Me.CMBJENIS.Value = ""
Me.CMBSATUAN.Value = ""
Me.CMBRUANG.Value = ""
Me.TXTJUMLAHBAIK.Value = ""
End If
End Sub
Private Sub AmbilBarangBaik()
Dim DBARANG As Long
Dim iRow As Long
iRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
DBARANG = Application.WorksheetFunction.CountA(Sheet3.Range("A5:A900000"))
If DBARANG = 0 Then
Me.TABELBARANG.RowSource = ""
Else
Me.TABELBARANG.RowSource = "BARANGBAIK!A5:L" & iRow
End If
End Sub
Private Sub CMDCARI_Click()
On Error GoTo Salah
Dim iRow As Long
Dim DCARIBARANG As Object
Set DCARIBARANG = Sheet3
Sheet3.Range("N4").Value = Me.CMBBERDASARKAN.Value
Sheet3.Range("N5").Value = Me.TXTKATAKUNCI.Value
DCARIBARANG.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet3.Range("N4:N5"), CopyToRange:=Sheet3.Range("P4:W4"), Unique:=False
iRow = Sheet3.Range("P" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet3.Range("P5:P999999")) = 0 Then
Me.TABELBARANG.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELBARANG.RowSource = "BARANGBAIK!P5:AA" & iRow
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CMDCETAK_Click()
Application.ScreenUpdating = False
If Me.TABELBARANG.RowSource = "" Then
Call MsgBox("Silahkan tekan tombol cari terlebih dahulu untuk mencetak Laporan", vbInformation,
"Cetak Barang Baik")
Else
Select Case MsgBox("Anda akan mencetak data barang baik" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Data")
Case vbNo
Exit Sub
Case vbYes
End Select
Unload Me
Sheet3.PrintPreview
FORMBARANGBAIK.Show
End If
Sheet1.Select
End Sub
Private Sub CMDDELETE_Click()
Application.ScreenUpdating = False
Dim HapusData As Object
Me.TABELBARANG.Value = ""
If Me.TXTNOMOR.Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
'Membuat pesan konfirmasi hapus data
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
Sheet3.Select
Selection.EntireRow.Delete
Me.CMDADD.Enabled = True
Call AmbilBarangBaik
Me.TXTIDINV.Value = ""
Me.TXTNAMA.Value = ""
Me.TXTDESKRIPSI.Value = ""
Me.CMBJENIS.Value = ""
Me.CMBSATUAN.Value = ""
Me.CMBRUANG.Value = ""
Me.TXTJUMLAHBAIK.Value = ""
Me.TXTNOMOR.Value = ""
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Sheet1.Select
End If
End Sub
Private Sub CMDRESET_Click()
Me.TXTIDINV.Value = ""
Me.TXTNAMA.Value = ""
Me.TXTDESKRIPSI.Value = ""
Me.CMBJENIS.Value = ""
Me.CMBSATUAN.Value = ""
Me.CMBRUANG.Value = ""
Me.TXTJUMLAHBAIK.Value = ""
Me.TXTNOMOR.Value = ""
Me.CMBBERDASARKAN.Value = ""
Me.TXTKATAKUNCI.Value = ""
Call AmbilBarangBaik
End Sub
Private Sub CMDUPDATE_Click()
Application.ScreenUpdating = False
'Perintah membuat Sumber data yang diubah
Dim UbahData As Object
'Perintah mengecek apakah ada data yang diubah
If Me.TXTNOMOR.Value = "" Then
Call MsgBox("Untuk mengubah Data, Pilih data terlebih dahulu", vbInformation, "Ubah Data")
Else
Set UbahData = Sheet3.Range("A5:A900000").Find(What:=Me.TXTNOMOR.Value, LookIn:=xlValues)
'Perintah mengubah data dari kolom pertama
UbahData.Offset(0, 1).Value = Me.TXTIDINV.Value
UbahData.Offset(0, 2).Value = Me.TXTNAMA.Value
UbahData.Offset(0, 3).Value = Me.TXTDESKRIPSI.Value
UbahData.Offset(0, 4).Value = Me.CMBJENIS.Value
UbahData.Offset(0, 5).Value = Me.CMBSATUAN.Value
UbahData.Offset(0, 6).Value = Me.CMBRUANG.Value
UbahData.Offset(0, 7).Value = Me.TXTJUMLAHBAIK.Value
Me.CMDADD.Enabled = True
'Perintah memunculkan pesan bahwa data berhasil diubah
Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")
'Perintah membersihkan textbox
Me.TXTIDINV.Value = ""
Me.TXTNAMA.Value = ""
Me.TXTDESKRIPSI.Value = ""
Me.CMBJENIS.Value = ""
Me.CMBSATUAN.Value = ""
Me.CMBRUANG.Value = ""
Me.TXTJUMLAHBAIK.Value = ""
Me.TXTNOMOR.Value = ""
End If
End Sub
Private Sub TABELBARANG_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
Dim SUMBERUBAH As String
Dim CELLAKTIF As String
On Error GoTo EXCELVBA
Me.TXTNOMOR.Value = Me.TABELBARANG.Value
Me.TXTIDINV.Value = Me.TABELBARANG.Column(1)
Me.TXTNAMA.Value = Me.TABELBARANG.Column(2)
Me.TXTDESKRIPSI.Value = Me.TABELBARANG.Column(3)
Me.CMBJENIS.Value = Me.TABELBARANG.Column(4)
Me.CMBSATUAN.Value = Me.TABELBARANG.Column(5)
Me.CMBRUANG.Value = Me.TABELBARANG.Column(6)
Me.TXTJUMLAHBAIK.Value = Me.TABELBARANG.Column(7)
Me.CMDADD.Enabled = False
Sheet3.Select
SUMBERUBAH = Sheets("BARANGBAIK").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("BARANGBAIK").Range("A5:A" & SUMBERUBAH).Find(What:=Me.TXTNOMOR.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheet1.Select
Exit Sub
EXCELVBA:
Call MsgBox("Harap klik 2x pada tabel data", vbInformation, "Data Pegawai")
End Sub
Private Sub UserForm_Initialize()
Call AmbilBarangBaik
With CMBJENIS
.AddItem "Jenis Barang 1"
.AddItem "Jenis Barang 2"
.AddItem "Jenis Barang 3"
.AddItem "Jenis Barang 4"
End With
With CMBSATUAN '
.AddItem "Buah"
.AddItem "Kotak"
.AddItem "Meter"
.AddItem "Lusin"
End With
With CMBRUANG
.AddItem "Ruang 1"
.AddItem "Ruang 2"
.AddItem "Ruang 3"
.AddItem "Ruang 4"
.AddItem "Ruang 5"
.AddItem "Ruang 6"
End With
With CMBBERDASARKAN
.AddItem "ID Inventaris"
.AddItem "Nama Barang"
.AddItem "Ruang"
.AddItem "Jenis Barang"
End With
End Sub
