3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform
3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform - Hallo sahabat TUTORIAL CUY, Pada Artikel yang anda baca kali ini dengan judul 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform, kami telah mempersiapkan artikel ini dengan baik untuk anda baca dan ambil informasi didalamnya. mudah-mudahan isi postingan
Artikel MICROSOFT,
Artikel MS EXCEL, yang kami tulis ini dapat anda pahami. baiklah, selamat membaca.
Judul : 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform
link : 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform
Anda sekarang membaca artikel 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform dengan alamat link https://tutorialcuy.blogspot.com/2019/01/3-tutorial-gampang-menciptakan-form-isi.html
Judul : 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform
link : 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform
3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform
Pada goresan pena aku yang terdahulu perihal aplikasi persediaan barang terdiri dari beberapa worksheet yang dikombinasikan dengan form - form input untuk memudahkan pengguna mengisi ataupun menambahkan daftar barang. Form - form tersebut dibentuk memakai user form yang ada pada VBA editor di Excel. Bagi Kamu yang sudah mengenal dengan istilah user form pada VBA editor mungkin akan sangat gampang untuk membuatnya tapi bagaimana yang belum sama sekali ataupun gres mengenal istitilah ini. Disini aku akan menjelaskan bagaimana Tutorial menciptakan daftar isi barang tersebut memakai User Form pada VBA editor di Excel.
Tutorial-langkahnya yakni sebagai berikut:
Tutorial 1. Membuka Windows Project Explorer
- Tampilkan jendela VBA editor melalui sajian Developer
- Tampilkan jendela VBA editor melalui sajian Developer
- Tambahkan Form pada jendela VBA project melalui sajian Insert lalu klik Usert Form
Tambahkan tombol kontrol pada tiap-tiap frame dan atur tata letak sesuai dengan area yang tersedia pada tiap frame dengan teladan menyerupai gambar dibawah ini;
Tutorial 2. Menambahkan Kode Macro VB
Agar form yang telah dibentuk sanggup berjalan seTutorial otomatis dan sanggup digunakan untuk kebutuhan menginput data barang maka perlu ditambahkan arahan macro VB didalamnya.
Sebelum memasukkan arahan VB maka terlebih dahulu ubah properties name pada masing-masing tombol kontrol menyerupai keterangan dibawah ini;
ComboBox1 = CBFilter
TextBox1 = TBFilter
ListBox1 = LBFILTER
ComboBox2 = CBFILTERJENIS
TextBox1 = TBNama
TextBox2 = TBKode
TextBox3 = TBStok
TextBox4 = TBSatuan
CommandButton1 = CBOK
CommandButton2 = CBBatal
CommandButton5 = CBHapus
CommandButton5 = CMDTutup
- Lalu pada UserForm1 masukkan arahan menyerupai dibawah ini;
Option Explicit
Dim CbLock As Boolean, Simpan As Boolean
Dim FormMode As String
Dim harga As Double
Const MsgboxTitle = "Daftar Barang"
'=================================================================================
' CCCCC
'=================================================================================
Private Sub CBTAMBAH_Click()
Dim JmlMasuk, JmlKeluar, JmlSisa
CbLock = True
Unlok
TBKode.Value = Empty
TBNama.Value = Empty
TBStok.Value = Empty
FormMode = "Tambah"
End Sub
Private Sub CBBATAL_Click()
FormMode = "Ready"
CbLock = False
Unlok
RefreshControl
End Sub
Private Sub CBEDIT_Click()
CbLock = True
Unlok
FormMode = "Edit"
End Sub
Private Sub CBOK_Click()
Dim LnBrg As Integer
If TBKode.Value = Empty Then
MsgBox "Kode barang masih kosong", vbInformation, MsgboxTitle
Exit Sub
End If
If TBNama.Value = Empty Then
MsgBox "Nama barang masih kosong", vbInformation, MsgboxTitle
Exit Sub
End If
If FormMode = "Tambah" Then
LnBrg = SBBRG.Max + 1
Else
LnBrg = SBBRG.Value
End If
If Not CheckDup(TBKode.Value, "A", LnBrg, FormMode) Then GoTo ErrOk
With ThisWorkbook.Sheets("DataBarang")
Application.ScreenUpdating = True
.Unprotect
.Range("A" & LnBrg).Value = TBKode.Value
.Range("B" & LnBrg).Value = TBNama.Value
.Range("c" & LnBrg).Value = TBStok.Value
.Range("d" & LnBrg).Value = TBSatuan.Value
.Range("e" & LnBrg).Value = CBFILTERJENIS.Value
MsgBox FormMode & " data berhasil", vbInformation, MsgboxTitle
Simpan = True
.Protect
Application.ScreenUpdating = False
End With
If FormMode = "Tambah" Then
Sekrol
SBBRG.Value = SBBRG.Max
End If
CBBATAL_Click
Exit Sub
ErrOk:
MsgBox "No ID sudah dipakai", vbCritical, MsgboxTitle
Exit Sub
End Sub
Private Sub SBBRG_Change()
RefreshControl
End Sub
Private Sub TBHARGA_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo ErrHarga
harga = TBHARGA.Value
TBHARGA.Value = FormatNumber(harga, 0, vbTrue, vbTrue, vbTrue)
Exit Sub
ErrHarga:
MsgBox "Hanya Boleh Berisi Angka Saja!", vbOKOnly + vbCritical, MsgboxTitle
harga = 0
TBHARGA = FormatNumber(harga, 0, vbTrue, vbTrue, vbTrue)
End Sub
Private Sub TBHARGA_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If IsNumeric(Chr(KeyAscii)) = False And KeyAscii <> vbKeyBack And KeyAscii <> 44 Then
KeyAscii = 0
End If
End Sub
Private Sub TBHARGA_Enter()
TBHARGA.Value = harga
End Sub
Private Sub CBXKOLFILTER_Change()
LBFILTER.RowSource = FilterBarang(TBFILTER.Value, CBXKOLFILTER.ListIndex)
End Sub
Private Sub LBFILTER_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim response As VbMsgBoxResult
If LBFILTER.Value = Null Then Exit Sub
response = MsgBox("tampilkan data " & LBFILTER.Value & " ??", vbYesNo + vbQuestion, MsgboxTitle)
If response = vbNo Then Exit Sub
SBBRG.Value = Application.WorksheetFunction.Match(LBFILTER.Value, ThisWorkbook.Sheets("DataBarang").Range("A:A"), 0)
End Sub
Private Sub TBFILTER_Change()
LBFILTER.RowSource = FilterBarang(TBFILTER.Value, CBXKOLFILTER.ListIndex)
End Sub
Private Sub UserForm_Activate()
Dim text1 As control
Dim i As Integer
Application.Calculation = xlCalculationManual
ThisWorkbook.Activate
Sheets("DataBarang").Select
Application.ScreenUpdating = False
Call Sekrol
CBXKOLFILTER.Clear
For i = 1 To 3
CBXKOLFILTER.AddItem Sheets("DataBarang").Cells(1, i).Value
Next i
CBXKOLFILTER.ListIndex = 1
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(2, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(3, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(4, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(5, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(6, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(7, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(8, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(9, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(10, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(11, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(12, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(13, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(14, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(15, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(16, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(17, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(18, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(19, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(20, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(21, 1)
CbLock = False
Call Unlok
FormMode = "Ready"
Simpan = False
Set text1 = Controls.Add("Forms.Label.1", "TT", True)
text1.Move 12, 360, 420, 12
text1.Caption = AuthorGen2()
If SBBRG.Max = 1 Then
MsgBox "Data masih kosong", vbInformation, MsgboxTitle
Call CBTAMBAH_Click
CBBATAL.Enabled = False
Exit Sub
End If
RefreshControl
End Sub
Private Sub UserForm_Terminate()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ThisWorkbook.Sheets("DataBarang").Range("A" & SBBRG.Value & ":E" & SBBRG.Value).Select
ThisWorkbook.Sheets("DataBarang").Protect
If Simpan Then ThisWorkbook.Save
End Sub
'=================================================================================
' FFFFFFF
'=================================================================================
Private Function CheckDup(w As Variant, x As String, y As Integer, z As String) As Boolean
Dim TempCD1, TempCD2, RgLook
On Error GoTo ErrCheckDup
CheckDup = True
RgLook = x & "1:" & x & SBBRG.Max
TempCD1 = Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("DataBarang").Range(RgLook), w)
If z = "Tambah" Then
If TempCD1 > 0 Then CheckDup = False
ElseIf z = "Edit" Then
If TempCD1 > 1 Then
CheckDup = False
ElseIf TempCD1 = 1 Then
TempCD2 = Application.WorksheetFunction.Match(w, ThisWorkbook.Sheets("DataBarang").Range(RgLook), 0)
If TempCD2 <> y Then CheckDup = False
End If
End If
Exit Function
ErrCheckDup:
MsgBox "ErrCheckDup", vbCritical, MsgboxTitle
CheckDup = False
End Function
'=================================================================================
' PPPPPPP
'=================================================================================
Private Sub Unlok()
CBTambah.Enabled = Not CbLock
CBEdit.Enabled = Not CbLock
SBBRG.Enabled = Not CbLock
CBOK.Enabled = CbLock
CBBATAL.Enabled = CbLock
TBKode.Locked = Not CbLock
TBNama.Locked = Not CbLock
TBStok.Locked = Not CbLock
End Sub
Private Sub Sekrol()
SBBRG.Max = LastCell(ThisWorkbook.Name, "DataBarang", "A")
If SBBRG.Max <= 1 Then
SBBRG.Min = 1
Else
SBBRG.Min = 2
End If
SBBRG.LargeChange = Round(SBBRG.Max / 5, 0)
End Sub
Private Sub RefreshControl()
Dim JmlMasuk, JmlKeluar, JmlSisa
With ThisWorkbook.Sheets("DataBarang")
TBKode.Value = .Cells(SBBRG, 1).Value
TBNama.Value = .Cells(SBBRG, 2).Value
TBStok.Value = .Cells(SBBRG, 3).Value
End With
End Sub
Private Sub CMDTutup_Click()
Unload Me
End Sub
Maka akan muncul form yang nantinya akan kita design sesuai dengan apa yang kita inginkan.
Untuk mendesign form tersebut biar sesuai dengan yang kita harapkan maka di perlukan tool-tool menyerupai Combo List, Combo Box, Text Box, Command Button, Dll. Semua tool tersebut telah disediakan didalam sajian Toolbox menyerupai terlihat pada gambar dibawah ini ;
Tutorial 2. Mendesign Tampilan User Form
- Ubah Properties UserForm1 dengan kriteria Height : 295, Width : 490, menyerupai yang terlihat pada gambar dibawah ini;
- Tambahkan 4 buah Frame pada UserForm1 yang tersedia pada sajian Toolbox, dan atur tata letak sehingga terlihat menyerupai gambar dibawah ini.
- Ubah Properties Caption untuk tiap-tiap frame, sepeti terlihat pada gambar dibawah ini;
Frame1 ubah ubah properties caption menjadi Data Barang.
Frame2 ubah properties caption menjadi Jenis
Frame3 ubah properties caption menjadi Informasi Barang
Frame4 ubah properties caption menjadi " " atau ( kosongkan saja )
Jika Kamu telah melaksanakan menyerupai yang aku jelaskan di atas maka tampilan UserFrom1 menjadi terlihat menyerupai dibawah ini;
Lalu ubah properties caption pada masing-masing tombol kontrol menyerupai yang telah aku jelaskan diatas sehingga tampilan form menjadi terlihat menyerupai gambar dibawah ini;
Agar form yang telah dibentuk sanggup berjalan seTutorial otomatis dan sanggup digunakan untuk kebutuhan menginput data barang maka perlu ditambahkan arahan macro VB didalamnya.
Sebelum memasukkan arahan VB maka terlebih dahulu ubah properties name pada masing-masing tombol kontrol menyerupai keterangan dibawah ini;
ComboBox1 = CBFilter
TextBox1 = TBFilter
ListBox1 = LBFILTER
ComboBox2 = CBFILTERJENIS
TextBox1 = TBNama
TextBox2 = TBKode
TextBox3 = TBStok
TextBox4 = TBSatuan
CommandButton1 = CBOK
CommandButton2 = CBBatal
CommandButton3 = CBTambah
CommandButton4 = CBEditCommandButton5 = CBHapus
CommandButton5 = CMDTutup
- Lalu pada UserForm1 masukkan arahan menyerupai dibawah ini;
Option Explicit
Dim CbLock As Boolean, Simpan As Boolean
Dim FormMode As String
Dim harga As Double
Const MsgboxTitle = "Daftar Barang"
'=================================================================================
' CCCCC
'=================================================================================
Private Sub CBTAMBAH_Click()
Dim JmlMasuk, JmlKeluar, JmlSisa
CbLock = True
Unlok
TBKode.Value = Empty
TBNama.Value = Empty
TBStok.Value = Empty
FormMode = "Tambah"
End Sub
Private Sub CBBATAL_Click()
FormMode = "Ready"
CbLock = False
Unlok
RefreshControl
End Sub
Private Sub CBEDIT_Click()
CbLock = True
Unlok
FormMode = "Edit"
End Sub
Private Sub CBOK_Click()
Dim LnBrg As Integer
If TBKode.Value = Empty Then
MsgBox "Kode barang masih kosong", vbInformation, MsgboxTitle
Exit Sub
End If
If TBNama.Value = Empty Then
MsgBox "Nama barang masih kosong", vbInformation, MsgboxTitle
Exit Sub
End If
If FormMode = "Tambah" Then
LnBrg = SBBRG.Max + 1
Else
LnBrg = SBBRG.Value
End If
If Not CheckDup(TBKode.Value, "A", LnBrg, FormMode) Then GoTo ErrOk
With ThisWorkbook.Sheets("DataBarang")
Application.ScreenUpdating = True
.Unprotect
.Range("A" & LnBrg).Value = TBKode.Value
.Range("B" & LnBrg).Value = TBNama.Value
.Range("c" & LnBrg).Value = TBStok.Value
.Range("d" & LnBrg).Value = TBSatuan.Value
.Range("e" & LnBrg).Value = CBFILTERJENIS.Value
MsgBox FormMode & " data berhasil", vbInformation, MsgboxTitle
Simpan = True
.Protect
Application.ScreenUpdating = False
End With
If FormMode = "Tambah" Then
Sekrol
SBBRG.Value = SBBRG.Max
End If
CBBATAL_Click
Exit Sub
ErrOk:
MsgBox "No ID sudah dipakai", vbCritical, MsgboxTitle
Exit Sub
End Sub
Private Sub SBBRG_Change()
RefreshControl
End Sub
Private Sub TBHARGA_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo ErrHarga
harga = TBHARGA.Value
TBHARGA.Value = FormatNumber(harga, 0, vbTrue, vbTrue, vbTrue)
Exit Sub
ErrHarga:
MsgBox "Hanya Boleh Berisi Angka Saja!", vbOKOnly + vbCritical, MsgboxTitle
harga = 0
TBHARGA = FormatNumber(harga, 0, vbTrue, vbTrue, vbTrue)
End Sub
Private Sub TBHARGA_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If IsNumeric(Chr(KeyAscii)) = False And KeyAscii <> vbKeyBack And KeyAscii <> 44 Then
KeyAscii = 0
End If
End Sub
Private Sub TBHARGA_Enter()
TBHARGA.Value = harga
End Sub
Private Sub CBXKOLFILTER_Change()
LBFILTER.RowSource = FilterBarang(TBFILTER.Value, CBXKOLFILTER.ListIndex)
End Sub
Private Sub LBFILTER_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim response As VbMsgBoxResult
If LBFILTER.Value = Null Then Exit Sub
response = MsgBox("tampilkan data " & LBFILTER.Value & " ??", vbYesNo + vbQuestion, MsgboxTitle)
If response = vbNo Then Exit Sub
SBBRG.Value = Application.WorksheetFunction.Match(LBFILTER.Value, ThisWorkbook.Sheets("DataBarang").Range("A:A"), 0)
End Sub
Private Sub TBFILTER_Change()
LBFILTER.RowSource = FilterBarang(TBFILTER.Value, CBXKOLFILTER.ListIndex)
End Sub
Private Sub UserForm_Activate()
Dim text1 As control
Dim i As Integer
Application.Calculation = xlCalculationManual
ThisWorkbook.Activate
Sheets("DataBarang").Select
Application.ScreenUpdating = False
Call Sekrol
CBXKOLFILTER.Clear
For i = 1 To 3
CBXKOLFILTER.AddItem Sheets("DataBarang").Cells(1, i).Value
Next i
CBXKOLFILTER.ListIndex = 1
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(2, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(3, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(4, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(5, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(6, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(7, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(8, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(9, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(10, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(11, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(12, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(13, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(14, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(15, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(16, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(17, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(18, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(19, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(20, 1)
CBFILTERJENIS.AddItem Sheets("DataBarang").Range("K:K").Cells(21, 1)
CbLock = False
Call Unlok
FormMode = "Ready"
Simpan = False
Set text1 = Controls.Add("Forms.Label.1", "TT", True)
text1.Move 12, 360, 420, 12
text1.Caption = AuthorGen2()
If SBBRG.Max = 1 Then
MsgBox "Data masih kosong", vbInformation, MsgboxTitle
Call CBTAMBAH_Click
CBBATAL.Enabled = False
Exit Sub
End If
RefreshControl
End Sub
Private Sub UserForm_Terminate()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ThisWorkbook.Sheets("DataBarang").Range("A" & SBBRG.Value & ":E" & SBBRG.Value).Select
ThisWorkbook.Sheets("DataBarang").Protect
If Simpan Then ThisWorkbook.Save
End Sub
'=================================================================================
' FFFFFFF
'=================================================================================
Private Function CheckDup(w As Variant, x As String, y As Integer, z As String) As Boolean
Dim TempCD1, TempCD2, RgLook
On Error GoTo ErrCheckDup
CheckDup = True
RgLook = x & "1:" & x & SBBRG.Max
TempCD1 = Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("DataBarang").Range(RgLook), w)
If z = "Tambah" Then
If TempCD1 > 0 Then CheckDup = False
ElseIf z = "Edit" Then
If TempCD1 > 1 Then
CheckDup = False
ElseIf TempCD1 = 1 Then
TempCD2 = Application.WorksheetFunction.Match(w, ThisWorkbook.Sheets("DataBarang").Range(RgLook), 0)
If TempCD2 <> y Then CheckDup = False
End If
End If
Exit Function
ErrCheckDup:
MsgBox "ErrCheckDup", vbCritical, MsgboxTitle
CheckDup = False
End Function
'=================================================================================
' PPPPPPP
'=================================================================================
Private Sub Unlok()
CBTambah.Enabled = Not CbLock
CBEdit.Enabled = Not CbLock
SBBRG.Enabled = Not CbLock
CBOK.Enabled = CbLock
CBBATAL.Enabled = CbLock
TBKode.Locked = Not CbLock
TBNama.Locked = Not CbLock
TBStok.Locked = Not CbLock
End Sub
Private Sub Sekrol()
SBBRG.Max = LastCell(ThisWorkbook.Name, "DataBarang", "A")
If SBBRG.Max <= 1 Then
SBBRG.Min = 1
Else
SBBRG.Min = 2
End If
SBBRG.LargeChange = Round(SBBRG.Max / 5, 0)
End Sub
Private Sub RefreshControl()
Dim JmlMasuk, JmlKeluar, JmlSisa
With ThisWorkbook.Sheets("DataBarang")
TBKode.Value = .Cells(SBBRG, 1).Value
TBNama.Value = .Cells(SBBRG, 2).Value
TBStok.Value = .Cells(SBBRG, 3).Value
End With
End Sub
Private Sub CMDTutup_Click()
Unload Me
End Sub
- Tambahkan module1 pada project VBA editor kemudian masukan arahan dibawah ini;
- Tambahkan module2 pada project VBA editor kemudian masukan arahan dibawah ini;
Option Explicit
Public Function FilterBarang(KeyWord As String, Kolom As Integer) As String
Dim RwCount As Integer
With ThisWorkbook.Sheets("TabelBarang")
.Range("A:H").Clear
.Cells(1, 1).Value = ThisWorkbook.Sheets("Databarang").Cells(1, Kolom + 1)
If Kolom < 1 Then
KeyWord = "*" & KeyWord
Else
KeyWord = KeyWord
End If
.Cells(2, 1).Value = KeyWord
With ThisWorkbook.Sheets("Databarang")
.Unprotect
If ThisWorkbook.Sheets("Databarang").Range("A1").CurrentRegion.Rows.Count <= 1 Then
FilterBarang = "TabelBarang!C2:E2"
Exit Function
End If
.Protect
If ThisWorkbook.Sheets("Databarang").Range("A65536").End(xlUp).Row = 1 Then Exit Function
End With
ThisWorkbook.Sheets("Databarang").Unprotect
ThisWorkbook.Sheets("Databarang").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:A2"), CopyToRange:=.Range("C1"), Unique:=False
ThisWorkbook.Sheets("Databarang").Protect
RwCount = Application.WorksheetFunction.CountA(.Range("C:C"))
If RwCount < 2 Then RwCount = 2
FilterBarang = "TabelBarang!C2:G" & RwCount
End With
End Function
Public Function LastCell(x, y, z) As Integer
With Workbooks(x).Sheets(y)
.Unprotect
LastCell = .Range(z & "1").CurrentRegion.Rows.Count
.Protect
End With
End Function
Public Function BrgDet(x, y)
Dim RgLook
Dim MatchLn
With ThisWorkbook.Sheets("Databarang")
.Unprotect
If .Range("A1").CurrentRegion.Rows.Count <= 1 Then
BrgDet = Empty
Exit Function
End If
RgLook = "A1:A" & .Range("A1").CurrentRegion.Rows.Count
MatchLn = Application.WorksheetFunction.Match(x, .Range(RgLook), 0)
BrgDet = .Range(y & MatchLn).Value
.Protect
End With
End Function
Public Function kategori() As Integer
With ThisWorkbook.Sheets("DataBarang")
ListIndex = Range("A:H").Select
End With
End Function
- Agar arahan macro VB di atas sanggup berjalan sebagaimana mestinya maka tambahkan worksheet gres pada workbook yang aktif kemudian rename menjadi TabelBarang.
- Untuk mencoba hasil dari arahan macro tersebut tekal tombol F5 pada keyboard komputer atau laptop Kamu.
Bagaimana mudahkan? ok silahkan Kamu mencoba tutorial ini !!! Jika ada yang perlu ditambahkan atau Kamu masih merasa kesulitan maka Kamu sanggup menanyakan ataupun menginformasikan melalu kolom komentar dibawah ini.
Sebagai materi untuk latihan Kamu juga sanggup memakai file yang sudah jadi hasil dari tutorial ini dengan mendownload pada link dibawah ini:
Demikianlah Artikel 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform
Sekianlah artikel 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform kali ini, mudah-mudahan bisa memberi manfaat untuk anda semua. baiklah, sampai jumpa di postingan artikel lainnya.
Anda sekarang membaca artikel 3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform dengan alamat link https://tutorialcuy.blogspot.com/2019/01/3-tutorial-gampang-menciptakan-form-isi.html
0 Response to "3 Tutorial Gampang Menciptakan Form Isi Barang Di Excel Menggunakan Userform"
Posting Komentar