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.
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
4 thoughts on “Control : Modern Listbox UI/UX”
Leave a Reply
Control Object
14 Topics
Tutorial Lainnya
untuk menampilkan hasil pencariannya gimana bang mohon pencerahannya
bang, saya coba kasih text yang pajang yang tampil kepotong, kira kira apa nya
terimakasih
Area Textbox nya kurang panjang
ada kendala di scrolbar nya tidak besa jalan hanya menampilkan 8 baris data saja, kira kira problem nya dimana ya
terimakasih