Tuesday, December 20, 2016

MEMBUAT LIST SEARCHING DATA DINAMIS

Bismillahi Rahmani Rahim
Assalamualaikum Wr. Wb.

Akhirnya bisa nulis lagi, kali ini pembahasan artikelnya mungkin sedikit jarang digunakan dan memang masih jarang penggunaan model ini.

Membuat "List Searching Data Dinamis" biasanya digunakan pada formulir input data untuk meminimalisir kesalahan input keyData seperti nama, Lokasi dan sebagainya, seperti contoh animasi aplikasi saya dibawah ini.

Pencarian nama driver dengan cara mengetikkan huruf yang terkandung dalam nama personal tersebut akan menampilkan driver tersebut pada list teratas. Jika nama telah berada di list teratas maka kita hanya menekan enter dan nama personal tersebut otomatis masuk ke textbox hasil pencarian.

Ok kita langsung saja ke TKP.

Alat dan Bahan :
- 1 File Berekstensi Macro Enabled
- 1 Userform, 1 Textbox, 1 Listbox
- 1 Image dan secukupnya Label

Assembly:
  1. Buat 1 File berekstensi macro enabled xlsm atau xlsb  dan rename salah satu sheet menjadi nama sheet "Sampel Data" dan isikan data seperti gambar dibawah ini. 
  2. Masuk ke jendela VBA (tekan Alt F11) kemudian insert Userform
  3. Klik Userform dan insert semua properti yang dingginkan seperti Textbox, Listbox, Image, Label dan atur sesuai keinginan tetapi ingat untuk mengganti nama masing-masing properti sesuai coding script dibawah ini :
  4. Userform = formPencarian, Textbox = txtCari, Listbox = lBoxPencarian, Label = lblNotif dan lblNotifENter, Image1
  5. Setelah mengganti semua nama property mari kita mulai mengatur posisi property agar lebih user friendly hahaha...... pakai bahasa istilah dikit boleh donk, lihat gambar berikut ini 
      


Sekarang mari kita double klik pada textbox (txtCari) kemudian masukkan script berikut :

Private Sub txtCari_AfterUpdate()
      On Error Resume Next
      Me.txtCari.Value = Me.lBoxPencarian.List(0, 0)
      Me.lBoxPencarian.Visible = False
      Me.lblNotifENter.Visible = False
End Sub

Private Sub txtCari_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    Me.txtCari.Value = Me.lBoxPencarian.List(0, 0)
    Me.lBoxPencarian.Visible = False
    Me.lblNotifENter.Visible = False
End Sub

Private Sub txtCari_Change()
    Me.lblNotifENter.Visible = True
    If Me.txtCari.Value = "" Then
        Me.lBoxPencarian.Visible = False
        Exit Sub
    End If
    
    Me.lBoxPencarian.Visible = True
    Dim shtPencarian    As Worksheet
    Dim BarisMulai      As Long
    Dim PosisiKolom     As Integer
    Dim TeksPencarian   As String
    Dim Hasil           As String
    Dim RngCell         As Range
    Dim rngCariUlang    As Range
                
            '============================== KODE KHUSUS LITSBOX =================================
            TeksPencarian = UCase(Me.txtCari.Value)                 'Teks yang dicari
            PosisiKolom = 2                                         'Kolom Kriteria Pencarian di Tabel Sheet
            BarisMulai = 4                                          'Pencarian dimulai di baris
            Set shtPencarian = ThisWorkbook.Sheets("Sampel Data")   'Setting Sheet Destinasi
            '====================================================================================
            
    Me.lBoxPencarian.Clear
        If Trim(TeksPencarian) <> "" Then
        Do Until shtPencarian.Cells(BarisMulai, PosisiKolom) = ""
            With shtPencarian.Range(shtPencarian.Cells(BarisMulai, PosisiKolom), shtPencarian.Cells(500, PosisiKolom))
            Set rngCariUlang = shtPencarian.Range(shtPencarian.Cells(BarisMulai, PosisiKolom), _
            shtPencarian.Cells(500, PosisiKolom))
                    Set Rng = .Find(What:=TeksPencarian, After:=.Cells(1), LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                    If Not Rng Is Nothing Then
                        Me.lBoxPencarian.AddItem Rng
                        On Error Resume Next
                        Hasil = Application.WorksheetFunction.Match(Me.lBoxPencarian.List(Me.lBoxPencarian.ListIndex + 1, 0), _
                        rngCariUlang, 0)
                    End If
            End With
        On Error GoTo Berhenti
        BarisMulai = Hasil + BarisMulai + 1
        Loop
        End If
Berhenti:
End Sub

Private Sub txtCari_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.lblNotif.Visible = True
End Sub



Untuk Listbox (lBoxPencarian) double klik dan masukkan script ini:
Private Sub lBoxPencarian_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.txtCari = Me.lBoxPencarian.List(0, 0)
    Me.lblNotifENter.Visible = False
End Sub


Untuk Userform DoubleClick dan masukkan ini
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      Me.lblNotif.Visible = False
End Sub

Untuk Image1 DoubleClick dan masukkan script ini: 
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.lblNotif.Visible = False
End Sub


Jangan lupa insert sebuah modul untuk script macro pemanggilan di sheet
di jendela VBA klik Insert >> Module kemudian masukkan script berikut

Sub tampilkancari()
    formPencarian.Show
End Sub

Kemudian di WorkSheet "Sampel Data" insert Shapes kotak saja kemudian klik kanan >> assign Macro... kemudian Pilih "tampilkancari"

SAVE hasil kerja anda :) ingat format xlsm atau xlsb

Hasil dari percobaan kita seperti animasi berikut



Untuk Contoh file dapat di lihat dengan klik link  kemudian cari judul file "List Seraching Data Dinamis". atau klik pada menu blog kemudian pilih Download >> File >> Aplikasi VBA.

Sekian artikel kali ini, jangan bosan untuk berkunjung semoga saran anda menghasilkan inspirasi baru :)
Wassalam


KJ99
EIUG Makassar











5 comments:

  1. Bisakah jika sudah kelihatan berbagai namanya
    Di klik di list box langsung namanya?
    Saya make walau d klik tetep yg paling atas yg terlihat

    ReplyDelete
  2. This comment has been removed by the author.

    ReplyDelete
  3. kalau yang di tampilkan 2 kolom sekaligus bisa ndak ya..??

    ReplyDelete
  4. Aku juga lagi nungu tampilakan 2 kolom dalam listview...

    ReplyDelete
  5. excel yg di download error, vbanya ga keluar

    ReplyDelete

resep donat empuk ala dunkin donut resep kue cubit coklat enak dan sederhana resep donat kentang empuk lembut dan enak resep es krim goreng coklat kriuk mudah dan sederhana resep es krim coklat lembut resep bolu karamel panggang sarang semut