Scribd
Upload
13 views

form_Suplier

The document contains VBA code for a user form that allows users to search, add, update, and delete supplier data in an Excel sheet. It includes error handling for data not found and ensures that all input fields are filled before adding new data. The form also initializes by populating a table with existing supplier data from a specified range in the worksheet.

Uploaded by

filmawati10
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
13 views

form_Suplier

The document contains VBA code for a user form that allows users to search, add, update, and delete supplier data in an Excel sheet. It includes error handling for data not found and ensures that all input fields are filled before adding new data. The form also initializes by populating a table with existing supplier data from a specified range in the worksheet.

Uploaded by

filmawati10
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 3

Private Sub CARI_Change()

Application.ScreenUpdating = False
Sheet2.Select
On Error GoTo Salah
Set Cari_Data = Sheet2
Cari_Data.Range("F5").Value = "*" & Me.CARI.Value & "*"
Cari_Data.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("F4:F5"), CopyToRange:=Sheet2.Range("H4:K4"), Unique:=False
Me.TABELDATA.RowSource = "Data_Suplier!H5:K" & Range("K" &
Rows.Count).End(xlUp).Row
Sheet2.Select
Exit Sub
Salah:
Call MsgBox("Maaf Mas Oyex Data tidak ditemukan", vbInformation, "Cari Data")
End Sub

Private Sub HAPUS_Click()


Application.ScreenUpdating = False
'Menentukan Object acuan data yang akan dihapus
If Me.KODE.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
'Menentukan tempat hapus data, menghapus data dan membersihkan form
Set Hapusdata = Sheet2.Range("A5:A40000").Find(What:=Me.KODE.Value,
LookIn:=xlValues)
Hapusdata.Offset(0, 0).ClearContents
Hapusdata.Offset(0, 1).ClearContents
Hapusdata.Offset(0, 2).ClearContents
Hapusdata.Offset(0, 3).ClearContents
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Me.KODE.Text = ""
Me.NAMA.Text = ""
Me.ALAMAT.Text = ""
Me.NOTLP.Text = ""
End If
Call Urut_Suplier
Me.TAMBAH.Enabled = True
End Sub

Private Sub Label12_Click()


Unload Me
End Sub

Private Sub RESET_Click()


Me.KODE.Text = ""
Me.NAMA.Text = ""
Me.ALAMAT.Text = ""
Me.NOTLP.Text = ""
Me.TAMBAH.Enabled = True
End Sub
Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
On Error GoTo Salah
Dim CellAktif, SUMBERUBAH As Long
Me.KODE.Value = Me.TABELDATA.Value
Me.NAMA.Value = Me.TABELDATA.Column(1)
Me.NOTLP.Value = Me.TABELDATA.Column(2)
Me.ALAMAT.Value = Me.TABELDATA.Column(3)
Me.TAMBAH.Enabled = False
Sheet2.Select
SUMBERUBAH = Sheets("Data_Suplier").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Data_Suplier").Range("A5:A" & SUMBERUBAH).Find(What:=TABELDATA.Value,
LookIn:=xlValues, Lookat:=xlWhole).Activate
CellAktif = ActiveCell.Row
Sheets("TABELDATA").Range("A" & CellAktif & ":D" & CellAktif).Select
Exit Sub
Salah:
FORM_PEMBELIAN.KODE_SUPLIER.Text = Me.KODE.Text
FORM_PEMBELIAN.NAMA_SUPLIER.Text = Me.NAMA.Text
FORM_PEMBELIAN.TELEPON.Text = Me.NOTLP.Text
FORM_PEMBELIAN.ALAMAT.Text = Me.ALAMAT.Text

End Sub

Private Sub TAMBAH_Click()


Application.ScreenUpdating = False
FORM_PEMBELIAN.KODE_SUPLIER.Text = Me.KODE.Text
FORM_PEMBELIAN.NAMA_SUPLIER.Text = Me.NAMA.Text
FORM_PEMBELIAN.TELEPON.Text = Me.NOTLP.Text
FORM_PEMBELIAN.ALAMAT.Text = Me.ALAMAT.Text
Dim DataCustomer As Object
Set DataCustomer = Sheet2.Range("A10000").End(xlUp)
If Me.KODE.Value = "" _
Or Me.NAMA.Value = "" _
Or Me.ALAMAT.Value = "" _
Or Me.NOTLP.Value = "" Then
Call MsgBox("Maaf, Data input harus lengkap", vbInformation, "Input Data")
Else
DataCustomer.Offset(1, 0).Value = Me.KODE.Value
DataCustomer.Offset(1, 1).Value = Me.NAMA.Value
DataCustomer.Offset(1, 2).Value = Me.NOTLP.Value
DataCustomer.Offset(1, 3).Value = Me.ALAMAT.Value
On Error Resume Next
Sheet2.Select
TABELDATA.RowSource = "_Data_Suplier!A5:D" & Range("D" & Rows.Count).End(xlUp).Row
Call MsgBox("Data berhasil ditambah", vbInformation, "Input Data")
Me.KODE.Text = ""
Me.NAMA.Text = ""
Me.ALAMAT.Text = ""
Me.NOTLP.Text = ""
End If
End Sub

Private Sub UBAH_Click()


Application.ScreenUpdating = False
Dim Baris, SUMBERUBAH As String
If Me.KODE.Text = "" Then
Call MsgBox("Pilih data terlebih dahulu", vbInformation, "Pilih Data")
Else
Sheet2.Select
SUMBERUBAH = Sheets("Data_Suplier").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Data_Suplier").Range("A5:A" & SUMBERUBAH).Find(What:=TABELDATA.Text,
LookIn:=xlValues, Lookat:=xlWhole).Activate
Baris = ActiveCell.Row
Cells(Baris, 1) = Me.KODE.Text
Cells(Baris, 2) = Me.NAMA.Text
Cells(Baris, 3) = Me.NOTLP.Text
Cells(Baris, 4) = Me.ALAMAT.Text

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


Me.KODE.Text = ""
Me.NAMA.Text = ""
Me.NOTLP.Text = ""
Me.ALAMAT.Text = ""
End If
Me.TAMBAH.Enabled = True
Sheet2.Select
End Sub

Private Sub UserForm_Initialize()


Application.ScreenUpdating = False
Sheet2.Select
Me.TABELDATA.RowSource = "Data_Suplier!A5:D" & Range("D" &
Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
HideTitleBar Me
End Sub

You might also like