CODING BARANG KELUAR

Option Explicit

Private Sub CBIDBARANG_Change()

On Error GoTo EXCELVBA

Dim CariBarang As Object

Set CariBarang = Sheet2.Range("B4:B10000").Find(What:=Me.CBIDBARANG.Value, LookIn:=xlValues)

Me.TXTNAMABARANG.Value = CariBarang.Offset(0, 1).Value

Me.TXTSATUAN.Value = CariBarang.Offset(0, 3).Value

Me.TXTGUDANG.Value = CariBarang.Offset(0, 4).Value

Me.TXTSTOK.Value = CariBarang.Offset(0, 5).Value

Me.TXTSTOK.Enabled = False

Me.TXTTOTALSTOK.Enabled = False

Exit Sub

EXCELVBA:

Call MsgBox("Maaf, Id barang belum terdaftar", vbInformation, "Data Barang")

End Sub

Private Sub CMDADD_Click()

Dim DBMASUK As Object

Dim UpdateStok As Object

Set DBMASUK = Sheet4.Range("B100000").End(xlUp)

Set UpdateStok = Sheet2.Range("B4:B10000").Find(What:=Me.CBIDBARANG.Value,

If Me.TXTIDTRANSAKSI.Value = "" _

Or Me.TXTTANGGAL.Value = "" _

Or Me.CBIDBARANG.Value = "" _
Or Me.TXTKELUAR.Value = "" Then

Call MsgBox("Isi data barang masuk dengan lengkap", vbInformation, "Barang Masuk")

Else

DBMASUK.Offset(1, -1).Value = "=ROW()-ROW(BARANGMASUK!$A$3)"

DBMASUK.Offset(1, 0).Value = Me.TXTIDTRANSAKSI.Value

DBMASUK.Offset(1, 1).Value = Me.TXTTANGGAL.Value

DBMASUK.Offset(1, 2).Value = Me.CBIDBARANG.Value

DBMASUK.Offset(1, 3).Value = Me.TXTNAMABARANG.Value

DBMASUK.Offset(1, 4).Value = Me.TXTSATUAN.Value

DBMASUK.Offset(1, 5).Value = Me.TXTGUDANG.Value

DBMASUK.Offset(1, 6).Value = Me.TXTKELUAR.Value

UpdateStok.Offset(0, 5).Value = Me.TXTTOTALSTOK.Value

Call AmbilData

Call MsgBox("Data barang keluar telah disimpan", vbInformation, "Barang Keluar")

Me.TXTIDTRANSAKSI.Value = ""

Me.TXTTANGGAL.Value = ""

Me.CBIDBARANG.Value = ""

Me.TXTNAMABARANG.Value = ""

Me.TXTSATUAN.Value = ""

Me.TXTSTOK.Value = ""

Me.TXTKELUAR.Value = ""

Me.TXTTOTALSTOK.Value = ""

End If

End Sub

Private Sub CMDBARU_Click()

Dim X As Long
X = Sheet4.Range("J3").Value + 1

Sheet4.Range("J3").Value = X

If Sheet4.Range("J2").Value = 1 Then

Me.TXTIDTRANSAKSI.Value = "BK-100000" & X

End If

If Sheet4.Range("J2").Value = 2 Then

Me.TXTIDTRANSAKSI.Value = "BK-10000" & X

End If

If Sheet4.Range("J2").Value = 3 Then

Me.TXTIDTRANSAKSI.Value = "BK-1000" & X

End If

If Sheet4.Range("J2").Value = 4 Then

Me.TXTIDTRANSAKSI.Value = "BK-100" & X

End If

If Sheet4.Range("J2").Value = 5 Then

Me.TXTIDTRANSAKSI.Value = "BK-10" & X

End If

Me.TXTIDTRANSAKSI.Enabled = False

Call GetData

End Sub

Private Sub GetData()

Dim TData As Long

Dim iRow As Long

iRow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row

TData = Application.WorksheetFunction.CountA(Sheet2.Range("B4:B10000"))

If TData = 0 Then

Me.CBIDBARANG.RowSource = ""

Else
Me.CBIDBARANG.RowSource = "DATABARANG!B4:C" & iRow

End If

End Sub

Private Sub AmbilData()

Dim TData As Long

Dim iRow As Long

iRow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row

TData = Application.WorksheetFunction.CountA(Sheet3.Range("B4:B10000"))

If TData = 0 Then

Me.TABELDATA.RowSource = ""

Else

Me.TABELDATA.RowSource = "BARANGKELUAR!A4:H" & iRow

End If

Me.TXTTOTALBARANG.Value = Me.TABELDATA.ListCount

End Sub

Private Sub CMDCARI_Click()

On Error GoTo Salah

Dim iRow As Long

Dim CARI_DATA As Object

Set CARI_DATA = Sheet4

Sheet7.Range("L2").Value = ">=" & Me.TANGGALAWAL.Value

Sheet7.Range("M2").Value = "<=" & Me.TANGGALAKHIR.Value

Me.TABELDATA.Value = ""

CARI_DATA.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _

Sheet7.Range("L1:M2"), CopyToRange:=Sheet7.Range("A1:H1"), Unique:=False

iRow = Sheet7.Range("A" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Else

Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")

End If

Me.TXTTOTALBARANG.Value = Me.TABELDATA.ListCount

Exit Sub

Salah:

Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")

End Sub

Private Sub CMDCETAK_Click()

Select Case MsgBox("Anda akan mencetak laporan barang masuk" _

& vbCrLf & "Apakah anda yakin?" _

, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak data")

Case vbNo

Exit Sub

Case vbYes

End Select

Unload Me

Sheet7.PrintPreview

Sheet1.Select

End Sub

Private Sub CMDDELETE_Click()

Application.ScreenUpdating = False

Dim UpdateStok As Object

Set UpdateStok = Sheet2.Range("B4:B10000").Find(What:=Me.TXTIDBARANG.Value,

If Me.TXTIDHAPUS.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

Sheet4.Select

UpdateStok.Offset(0, 5).Value = UpdateStok.Offset(0, 5).Value + 0 + Me.STOKHAPUS.Value

Selection.EntireRow.Delete

Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")

Me.TXTIDTRANSAKSI.Value = ""

Me.TXTTANGGAL.Value = ""

Me.CBIDBARANG.Value = ""

Me.TXTNAMABARANG.Value = ""

Me.TXTSATUAN.Value = ""

Me.TXTSTOK.Value = ""

Me.TXTKELUAR.Value = ""

Me.TXTTOTALSTOK.Value = ""

Me.TXTIDHAPUS.Value = ""

Call AmbilData

Sheet1.Select

End If
End Sub

Private Sub CMDRESET_Click()

Me.TABELDATA.Value = ""

Me.TXTIDTRANSAKSI.Value = ""

Me.TXTTANGGAL.Value = ""

Me.CBIDBARANG.Value = ""

Me.TXTNAMABARANG.Value = ""

Me.TXTSATUAN.Value = ""

Me.TXTSTOK.Value = ""

Me.TXTKELUAR.Value = ""

Me.TXTTOTALSTOK.Value = ""

Me.TXTIDHAPUS.Value = ""

Me.TXTIDBARANG.Value = ""

Me.STOKHAPUS.Value = ""

Call AmbilData

Me.CMDDELETE.Enabled = True

Me.CMDADD.Enabled = True

Me.CMDBARU.Enabled = True

End Sub

Private Sub CMDUPDATE_Click()

Application.ScreenUpdating = False

'Perintah membuat Sumber data yang diubah

Dim UBAHDATA As Object

Dim UpdateStok As Object

Set UBAHDATA = Sheet4.Range("A4:A10000").Find(What:=Me.TABELDATA.Value, LookIn:=xlValues)

Set UpdateStok = Sheet2.Range("B4:B10000").Find(What:=Me.CBIDBARANG.Value,

If Me.TXTIDTRANSAKSI.Value = "" Then

Call MsgBox("Untuk mengubah Data, Pilih data terlebih dahulu", vbInformation, "Ubah Data")

Else

'Perintah mengubah data dari kolom pertama

UBAHDATA.Offset(0, 7).Value = Me.TXTKELUAR.Value

UpdateStok.Offset(0, 5).Value = Me.TXTTOTALSTOK.Value

'Perintah memunculkan pesan bahwa data berhasil diubah

Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")

'Perintah membersihkan textbox

Me.TXTIDTRANSAKSI.Value = ""

Me.TXTTANGGAL.Value = ""

Me.CBIDBARANG.Value = ""

Me.TXTNAMABARANG.Value = ""

Me.TXTSATUAN.Value = ""

Me.TXTSTOK.Value = ""

Me.TXTKELUAR.Value = ""

Me.TXTTOTALSTOK.Value = ""

Me.TXTIDHAPUS.Value = ""

Call AmbilData

Sheet1.Select

End If

End Sub

Private Sub TABELDATA_Click()

Dim SUMBERUBAH As String

Dim CELLAKTIF As String

Application.ScreenUpdating = False
Me.TXTIDHAPUS.Value = Me.TABELDATA.Column(1)

Me.STOKHAPUS.Value = Me.TABELDATA.Column(7)

Me.TXTIDBARANG.Value = Me.TABELDATA.Column(3)

Sheet4.Select

SUMBERUBAH = Sheets("BARANGKELUAR").Cells(Rows.Count, "B").End(xlUp).Row

Sheets("BARANGKELUAR").Range("B4:B" & SUMBERUBAH).Find(What:=Me.TXTIDHAPUS.Value,

CELLAKTIF = ActiveCell.Row

Me.CMDDELETE.Enabled = True

Me.CMDADD.Enabled = False

Me.TXTIDTRANSAKSI.Enabled = False

Me.CMDBARU.Enabled = False

Me.TXTIDHAPUS.Enabled = False

Me.STOKHAPUS.Enabled = False

Me.TXTIDBARANG.Enabled = False

Sheet1.Select

End Sub

Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim SUMBERUBAH, CELLAKTIF As String

Application.ScreenUpdating = False

'On Error GoTo EXCELVBA

Me.TXTIDTRANSAKSI.Value = Me.TABELDATA.Column(1)

Me.TXTTANGGAL.Value = Format(Me.TABELDATA.Column(2), "dd/mm/yyyy")

Me.CBIDBARANG.Value = Me.TABELDATA.Column(3)

Me.TXTNAMABARANG.Value = Me.TABELDATA.Column(4)

Me.TXTSATUAN.Value = Me.TABELDATA.Column(5)
Me.TXTKELUAR.Value = Me.TABELDATA.Column(7)

Me.TXTTOTALSTOK.Value = Me.TXTSTOK.Value

Sheet4.Select

SUMBERUBAH = Sheets("BARANGKELUAR").Cells(Rows.Count, "B").End(xlUp).Row

Sheets("BARANGKELUAR").Range("B4:B" & SUMBERUBAH).Find(What:=Me.TXTIDHAPUS.Value,

CELLAKTIF = ActiveCell.Row

Sheets("BARANGKELUAR").Range("A" & CELLAKTIF & ":H" & CELLAKTIF).Select

Sheet1.Select

Me.CMDDELETE.Enabled = False

Exit Sub

EXCELVBA:

Call MsgBox("Klik 2x pada tabel data", vbInformation, "Pilih Data")

End Sub

Private Sub TXTCARIBARANG_Change()

On Error GoTo Salah

Dim iRow As Long

Dim CARI_DATA As Object

Set CARI_DATA = Sheet4

Sheet7.Range("J1").Value = "Nama Barang"

Sheet7.Range("J2").Value = "*" & Me.TXTCARIBARANG.Value & "*"

Me.TABELDATA.Value = ""

CARI_DATA.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _

Sheet7.Range("J1:J2"), CopyToRange:=Sheet7.Range("A1:H1"), Unique:=False

iRow = Sheet6.Range("A" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Me.TABELDATA.RowSource = "CARIKELUAR!A2:H" & iRow

Else
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")

End If

Me.TXTTOTALBARANG.Value = Me.TABELDATA.ListCount

Exit Sub

Salah:

Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")

End Sub

Private Sub TXTKELUAR_Change()

On Error Resume Next

Me.TXTTOTALSTOK.Value = IIf(Me.TXTSTOK.Value = "", 0, Me.TXTSTOK.Value) -

+ 0 + IIf(Me.STOKHAPUS.Value = "", 0, Me.STOKHAPUS.Value)

End Sub

Private Sub UserForm_Initialize()

Call AmbilData

End Sub