Control : Modern Listbox UI/UX

Untuk membuat sebuah userform dengan tampilan yang lebih modern, sepertinya sulit dicapai jika menggunakan Listbox bawaan dari VBA Excel.

Karena Listbox tampilannya kaku dan juga terlihat jadul seperti Windows 98.

Nah disini saya buatkan alternatif yang lebih modern dimana tampilan Listbox bisa dibuat lebih menarik namun perlu sedikit proses dalam pembuatannya.

Contoh hasilnya bisa dilihat pada Gambar dibawah ini

Atau dengan list data yang lebih komplek dengan tambahan progress bar dan perhitungan persen seperti dibawah ini

Jika lebih suka tutorial dalam bentuk Video, bisa simak tutorial pembuatan Listbox Modern UI ini di video tutorial dibawah ini.

https://youtu.be/cMySLqp6BTw

Membuat Listbox Modern UI

Untuk membuat Listbox seperti diatas, diawali dengan membuat sebuah Frame terlebih dahulu, ini sangat penting karena Frame adalah tempat dimana nantinya control control diatas berada.

setelah Frame dibuat, buat sebuah standard module dan masukan script dibawah ini, untuk membuat model seperti di Gambar pertama

Public Cas As New Collection
Public Sub ModernList(Optional ByVal Tinggii As Long)
    Dim Top       As Variant
    Dim FontName  As String
    Dim LblLeft   As String

    Dim lblicon As MSForms.Label
    Dim lblCaseBack As MSForms.Label
    Dim lblHr As MSForms.Label
    
    Dim lblId As MSForms.Label
    Dim lblNama As MSForms.Label
    Dim lblIsActive As MSForms.Label
    Dim lblHarga As MSForms.Label
    Dim lblQty As MSForms.Label
    Dim lblTotal As MSForms.Label
    
    Dim btnDelete As MSForms.Label
    Dim myFormControl As MSForms.Frame

    Set myFormControl = UserForm1.Frame2
    Set myForm = UserForm1
    
    Banyak = Sheet1.Range("A" & Rows.Count).End(xlUp).Row - 1
    
    FontName = "MontSerrat Medium"

        With UserForm1.Frame2
            .Clear
            .Caption = ""
            .BorderStyle = fmBorderStyleSingle
            .BorderStyle = fmBorderStyleNone

            'Untuk Scroll Bar
            '--------------------------
            If lna > 5 Then
                .ScrollBars = fmScrollBarsVertical
                .ScrollHeight = lna * (Tinggii * 18 / .Height) * (.Height) / 151
            Else
                .ScrollBars = fmScrollBarsNone
            End If
            
            Top = 6
            Baris = 2
            
            If Banyak >= 1 Then
        '
                For i = 1 To Banyak
                LblLeft = 36
                
                Set lblicon = .Controls.Add("Forms.Label.1", "lblicon" & i, True)
                With lblicon
                    .Font.Name = "Segoe MDL2 Assets"
                    .Caption = ChrW(&HECCC)
                    .Font.Size = 10
                    .Left = 10
                    .Top = Top + 2
                    .Width = 15
                    .Height = 30
                    .ZOrder (0)
                    .BackStyle = fmBackStyleTransparent
                    .ForeColor = &HE77A00
                     LblLeft = .Left + .Width + 2
                End With
                '-----------------------------------------------------------------------
                
                Set lblNama = .Controls.Add("Forms.Label.1", "lblNama" & i, True)
                With lblNama
                    .Caption = Sheet1.Range("C" & Baris).Value
                    .Left = LblLeft
                    .Top = Top
                    .Height = 30
                    .Width = 124
                    .ZOrder (0)
                    .Font.Size = 10
                    .Font.Name = FontName
                    .BackStyle = fmBackStyleTransparent
                    .ForeColor = vbGrayText
                     LblLeft = .Left + .Width + 4
                End With


                Set lblIDbarang = .Controls.Add("Forms.Label.1", "lblIDbarang" & i, True)
                With lblIDbarang
                    .Caption = Sheet1.Range("B" & Baris).Value
                    .Left = lblNama.Left
                    .Top = lblNama.Top + 18
                    .Width = lblNama.Width
                    .ZOrder (0)
                    .Font.Size = 8
                    .Font.Name = "MontSerrat"
                    .BackStyle = fmBackStyleTransparent
                    .ForeColor = vbGrayText
                    LblLeft = .Left + .Width + 4
                End With
                '-----------------------------------------------------------------------
                
                Set lblHarga = .Controls.Add("Forms.Label.1", "lblHarga" & i, True)
                With lblHarga
                    .Caption = "Rp " & Format(Sheet1.Range("D" & Baris).Value, "#,##0")
                    .Left = LblLeft
                    .Top = Top
                    .Height = 30
                    .Width = 104
                    .ZOrder (0)
                    .Font.Size = 10
                    .Font.Name = FontName
                    .BackStyle = fmBackStyleTransparent
                    .ForeColor = vbGrayText
                     LblLeft = .Left + .Width + 4
                End With

                Set lblQty = .Controls.Add("Forms.Label.1", "lblQty" & i, True)
                With lblQty
                    .Caption = "Qty: " & Sheet1.Range("E" & Baris).Value
                    .Left = lblHarga.Left
                    .Top = lblHarga.Top + 18
                    .Width = lblHarga.Width
                    .ZOrder (0)
                    .Font.Size = 8
                    .Font.Name = "MontSerrat"
                    .BackStyle = fmBackStyleTransparent
                    .ForeColor = vbGrayText
                     LblLeft = .Left + .Width + 4
                End With
                '-----------------------------------------------------------------------
               
                Set lblTotal = .Controls.Add("Forms.Label.1", "lblTotal" & i, True)
                With lblTotal
                    .Caption = "Rp " & Format(Sheet1.Range("F" & Baris).Value, "#,##0")
                    .Left = LblLeft
                    .Top = Top
                    .Height = 30
                    .Width = 124
                    .ZOrder (0)
                    .Font.Size = 10
                    .Font.Name = FontName
                    .BackStyle = fmBackStyleTransparent
                    .ForeColor = vbGrayText
                     LblLeft = .Left + .Width + 4
                End With
                '-----------------------------------------------------------------------

                Set btnDelete = .Controls.Add("Forms.Label.1", "btnDelete" & i, True)
                With btnDelete
                    .Left = LblLeft
                    .Top = Top + 4
                    .Height = 15
                    .Width = 15
                    .ZOrder (0)
                    .Font.Name = "Segoe MDL2 Assets"
                    .Caption = ChrW(&HE107)
                    .Font.Size = 14
                    .ForeColor = vbGrayText
                    .BackStyle = fmBackStyleTransparent
                    .Tag = "tag2"
                     LblLeft = .Left + .Width + 4
                End With
                '-----------------------------------------------------------------------
                
                
                '***********************************************************************
                Set lblHr = .Controls.Add("Forms.Label.1", "lblHr" & i, True)
                With lblHr
                    .Left = 4
                    .Top = lblNama.Top + lblNama.Height + 6
                    .Width = myFormControl.Width - 20
                    .ZOrder (0)
                    .Height = 0.6
                    .BorderStyle = fmBorderStyleSingle
                    .BorderStyle = fmBorderStyleNone
                    .BackColor = &HFCE1C7
                    .BackStyle = fmBackStyleOpaque

                End With
                '-----------------------------------------------------------------------
                
                'untuk Events Class
                Set cls = New clsCase
                Set cls.lblNama = lblNama
                Set cls.lblHarga = lblHarga
                Set cls.lblTotal = lblTotal
                Set cls.lblDefaultCase = lblIsActive
                Set cls.btnDelete = btnDelete
                Set cls.myForm = myForm

                Cas.Add cls
                
                Top = Top + 40 + 2
                Baris = Baris + 1
                
                Next i
                
                'Hover Warna Baris
                '--------------
                Set lblCaseBack = .Controls.Add("Forms.Label.1", "lblCaseBack", True)
                With lblCaseBack
                    .Left = 4
                        If LblBackTop > 0 Then
                           .Top = LblBackTop
                        Else
                           .Top = 4
                        End If
                    .Width = myFormControl.Width - 20
                    .Height = 35
                    .BackColor = &HE0E0E0
                    .ZOrder (1)
                    .Visible = True
                End With

        End If

        End With
End Sub

Dan untuk bagian Events nya gunakan WithEvents agar tombol delete bisa diklik dan juga bisa dibuatkan Hover Warna untuk baris

Public WithEvents myForm As MSForms.UserForm
Public WithEvents myFormControl As MSForms.Frame
Public WithEvents lblId As MSForms.Label
Public WithEvents lblNama As MSForms.Label
Public WithEvents lblCaseBack As MSForms.Label
Public WithEvents lblHarga As MSForms.Label
Public WithEvents lblTotal As MSForms.Label
Public WithEvents btnEditCase As MSForms.Label
Public WithEvents btnDelete As MSForms.Label
Public WithEvents lblDefaultCase As MSForms.Label

Private Sub btnDelete_Click()
Pesan = MsgBox("Yakin akan di Hapus?", vbCritical + vbYesNo)
    If Pesan = vbYes Then
    'bagian Hapus
    End If
End Sub

Private Sub lbltotal_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Call lblCaseBackPosition(lblTotal)
End Sub

Private Sub lblharga_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Call lblCaseBackPosition(lblHarga)
End Sub

Private Sub lblnama_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Call lblCaseBackPosition(lblNama)
End Sub
Private Sub lblDefaultCase_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Call lblCaseBackPosition(lblDefaultCase, 5)
End Sub
Private Sub btnDelete_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call lblCaseBackPosition(btnDelete, 4)
Dim i As Integer
    For i = 1 To Banyak
       With CaseForm.Controls("btnDelete" & i)
            .ForeColor = vbGrayText
       End With
    Next i
     
    btnDelete.ForeColor = &H4F53D9
End Sub
Sub lblCaseBackPosition(ctr, Optional et As Integer)
    With myForm.Controls("lblCaseBack")
        .Top = ctr.Top - 2 - et
        LblCaseBackTop = .Top
    End With
    btnDelete.ForeColor = vbGrayText
End Sub

List Tutorial
Apa yang sedang kamu cari?

Temukan beberapa kata kunci yang diinginkan.

Search