3 Langkah Mudah Membuat Form Isi Barang Di Excel Menggunakan UserForm

Pada tulisan saya yang terdahulu tentang aplikasi persediaan barang terdiri dari beberapa worksheet yang dikombinasikan dengan form - form input untuk memudahkan pengguna mengisi ataupun menambahkan daftar barang. Form - form tersebut dibuat menggunakan user form yang ada pada VBA editor di Excel. Bagi Anda yang sudah mengenal dengan istilah user form pada VBA editor mungkin akan sangat mudah untuk membuatnya tapi bagaimana yang belum sama sekali ataupun baru mengenal istitilah ini.

Disini saya akan menjelaskan bagaimana cara membuat daftar isi barang tersebut menggunakan User Form pada VBA editor di Excel. 

Langkah-langkahnya adalah sebagai berikut: 

Langkah 1. Membuka Windows Project Explorer
- Tampilkan jendela VBA editor melalui menu Developer

- Tambahkan Form pada jendela VBA project melalui menu Insert lalu klik Usert Form

Maka akan muncul form yang nantinya akan kita design sesuai dengan apa yang kita inginkan. 

Untuk mendesign form tersebut agar sesuai dengan yang kita harapkan maka di perlukan tool-tool seperti Combo List, Combo Box, Text Box, Command Button, Dll. Semua tool tersebut telah disediakan didalam menu Toolbox seperti terlihat pada gambar dibawah ini ; 

Langkah 2. Mendesign Tampilan User Form

- Ubah Properties UserForm1 dengan kriteria Height : 295, Width : 490, seperti yang terlihat pada gambar dibawah ini; 

- Tambahkan 4 buah Frame pada UserForm1 yang tersedia pada menu Toolbox, dan atur tata letak sehingga terlihat seperti 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 Anda telah melakukan seperti yang saya jelaskan di atas maka tampilan UserFrom1 menjadi terlihat seperti dibawah ini; 

Tambahkan tombol kontrol pada tiap-tiap frame dan atur tata letak sesuai dengan area yang tersedia pada tiap frame dengan contoh seperti gambar dibawah ini;

Lalu ubah properties caption pada masing-masing tombol kontrol seperti yang telah saya jelaskan diatas sehingga tampilan form menjadi terlihat seperti gambar dibawah ini;

Langkah 2. Menambahkan Kode Macro VB 

Agar form yang telah dibuat dapat berjalan secara otomatis dan dapat digunakan untuk kebutuhan menginput data barang maka perlu ditambahkan kode macro VB didalamnya.
Sebelum memasukkan kode VB maka terlebih dahulu ubah properties name pada masing-masing tombol kontrol seperti 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 = CBEdit
CommandButton5 = CBHapus
CommandButton5 = CMDTutup

- Lalu pada UserForm1 masukkan kode seperti 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 lalu masukan kode dibawah ini; 

- Tambahkan module2 pada project VBA editor lalu masukan kode 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 kode macro VB di atas dapat berjalan sebagaimana mestinya maka tambahkan worksheet baru pada workbook yang aktif lalu rename menjadi TabelBarang. 

- Untuk mencoba hasil dari kode macro tersebut tekal tombol F5 pada keyboard komputer atau laptop Anda. 

Bagaimana mudahkan? ok silahkan Anda mencoba tutorial ini !!! Jika ada yang perlu ditambahkan atau Anda masih merasa kesulitan maka Anda bisa menanyakan ataupun menginformasikan melalu kolom komentar dibawah ini. 

Sebagai bahan untuk latihan Anda juga bisa menggunakan file yang sudah jadi hasil dari tutorial ini dengan mendownload pada link dibawah ini:

 

BERITA LENGKAP DI HALAMAN BERIKUTNYA

Halaman Berikutnya

Subscribe to receive free email updates: