Membuat Auto Complete pada Combo Box (VB)

Pada postingan kali ini saya akan membahas kembali mengenai Visual Basic yaitu Membuat Auto Complete pada Combo Box, maksud Auto Complete disini adalah Melengkapi Teks secara Otomatis pada saat sedang melakukan pengetikan ke data yang mendekati atau yang dinginkan, dengan catatan apabila data tersebut ada pada list data Combo Box tersebut.

Tip ini sangat berguna apabila menggunakan combobox yang di dalamnya terdiri atas ratusan bahkan ribuan data. User (pengguna/pemakai program) akan kesulitan jika harus memilih satu per satu menggunakan scroll combobox ke bawah hingga data yang diinginkan ketemu. Dengan adanya tip ini, user cukup hanya mengetikkan beberapa karakter awal, dan program akan otomatis melengkapinya, sehingga tidak perlu mengetik sampai akhir. Nah bagi yang berkenan untuk Tip ini silahkan ikuti langkah-lah berikut

• Buatlah Project Baru Standart Exe
• Tambahkan 1 buah ComboBox Style : Dropdown Combo
• Tambahkan 1 buah Module

'Ketik Coding berikut pada Module

Option Explicit

Const CB_FINDSTRING = &H14C

Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Public Enum EnumKarakter
Asli = 0
Ubah = 1
End Enum

Public Function AutoComplete( _
cbCombo As ComboBox, _
sKeyAscii As Integer, _
Optional bUpperCase As Boolean = True, _
Optional cCharacter As EnumKarakter = Asli) _
As Integer
Dim lngFind As Long, intPos As Integer
Dim intLength As Integer, tStr As String
With cbCombo
If sKeyAscii = 8 Then
If .SelStart = 0 Then Exit Function
.SelStart = .SelStart - 1
.SelLength = 32000
.SelText = ""
Else
intPos = .SelStart
tStr = .Text
If bUpperCase = True Then
.SelText = UCase(Chr(sKeyAscii))
Else
.SelText = (Chr(sKeyAscii))
End If
End If

lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, _
ByVal .Text)
If lngFind = -1 Then
Exit Function
Else
intPos = .SelStart
intLength = Len(.List(lngFind)) - Len(.Text)
If cCharacter = Ubah Then
.SelText = .SelText & Right(.List(lngFind), _
intLength)
Else
.Text = .List(lngFind)
End If
.SelStart = intPos
.SelLength = intLength
End If
End With
End Function

' Ketik Coding diberikut pada Form

Option Explicit

Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(Combo1, KeyAscii, False, Asli)
End Sub

Private Sub Form_Load()
Call AddData
End Sub

Private Sub AddData()
With Combo1
.Clear
.AddItem "Ana Lestari"
.AddItem "Budi Setiawan"
.AddItem "Eka Syahputra"
.AddItem "Wahyu Perdana"
.AddItem "Blog walking"
.AddItem "Terserah"
End With
End Sub

Kemudian Run (jalankan) Program atau tekan F5, lalu pada combobox coba ketik huruf a , maka secara Otomatis teks pada combobox akan menjadi Ana Lestari. Semoga Tip ini ada mamfaat nya bagi kita semua, dan jangan lupa nitip komennya ya, terimakasih sebelumnya ... salam

Menampilkan Angka Terbilang dengan Visual Basic

Senang rasanya bisa berbagi lagi buat temen-temen karena udah lama gak posting, kali ini tentang cara Menampilkan Angka Terbilang dengan Visual Basic. Maksud angka terbilang disini adalah penulisan angka-angka dengan huruf misalnya Rp. 1.500 jadi (Seribu Lima Ratus Rupiah) tapi tip kali ini hanya untuk penulisan bilangan genap saja dan belum bisa digunakan untuk bilangan decimal atu bilangan berkoma, untuk menghemat waktu dan jangan capek ngetiknya (udah pasti neh) lanjut aja kita dengan cara pembuatan coding nya, nah bagi yang berkenan silakan ikuti langkah-langkah berikut

Persiapan yang dilakukan

• Buat Project Baru Standart Exe

• Tambahkan 1 buah TextBox dan 1 Label

• Tambahkan 1 buah Module

’Ketik Coding dibawah ini pada module

Option Explicit

Public Const vbKeyDecPt = 46
Public Function ConvertirEnText(ValNum As Double) As String

Static Unites(0 To 9) As String
Static Dixaines(0 To 9) As String
Static LesDixaines(0 To 9) As String
Static Milliers(0 To 4) As String

Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim strResultat As String
Dim strTemp As String
Dim tmpBuff As String

Unites(0) = "nol"
Unites(1) = "satu"
Unites(2) = "dua"
Unites(3) = "tiga"
Unites(4) = "empat"
Unites(5) = "lima"
Unites(6) = "enam"
Unites(7) = "tujuh"
Unites(8) = "delapan"
Unites(9) = "sembilan"

Dixaines(0) = "sepuluh"
Dixaines(1) = "sebelas"
Dixaines(2) = "dua belas"
Dixaines(3) = "tiga belas"
Dixaines(4) = "empat belas"
Dixaines(5) = "lima belas"
Dixaines(6) = "enam belas"
Dixaines(7) = "tujuh belas"
Dixaines(8) = "delapan belas"
Dixaines(9) = "sembilan belas"

LesDixaines(0) = ""
LesDixaines(1) = "sepuluh"
LesDixaines(2) = "dua puluh"
LesDixaines(3) = "tiga puluh"
LesDixaines(4) = "empat puluh"
LesDixaines(5) = "lima puluh"
LesDixaines(6) = "enam puluh"
LesDixaines(7) = "tujuh puluh"
LesDixaines(8) = "delapan puluh"
LesDixaines(9) = "sembilan puluh"

Milliers(0) = ""
Milliers(1) = "ribu"
Milliers(2) = "juta"
Milliers(3) = "milyard"
Milliers(4) = "triliyun"

On Error GoTo NbVersTexteError

strTemp = CStr(Int(ValNum)) 'Untuk Konversi Angka yang di format ke default

For i = Len(strTemp) To 1 Step -1
ValNb = Val(Mid$(strTemp, i, 1))
nPosition = (Len(strTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 1 Then
tmpBuff = Unites(ValNb) & " "
Else
tmpBuff = ""
End If
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = Dixaines(ValNb) & " "
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Unites(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = ""
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
End If
strResultat = tmpBuff & strResultat
Case 2
If ValNb > 0 Then
strResultat = LesDixaines(ValNb) & " " & _
strResultat
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
strResultat = Unites(ValNb) & " ratus " & _
strResultat
Else
strResultat = "seratus " & strResultat
End If
End If
End Select
Next i
If Len(strResultat) > 0 Then
strResultat = UCase$(Left$(strResultat, 1)) & _
Mid$(strResultat, 2)
End If

EndNbVersTexte:
ConvertirEnText = strResultat & " rupiah"
Exit Function

NbVersTexteError:
strResultat = "Une Erreur !"
Resume EndNbVersTexte
End Function

Public Function AngkaTerbilang(Counter As Double) As String
On Error Resume Next
Dim A As Single
AngkaTerbilang = ConvertirEnText(Counter)
A = Len(ConvertirEnText(Counter))
If Mid(ConvertirEnText(Counter), 1, 4) = "Ribu" Then
AngkaTerbilang = "Se" + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 4) = "Juta" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 7) = "" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
If Mid(ConvertirEnText(Counter), 1, 7) = "Milyard" Then
AngkaTerbilang = "Satu " + Mid(ConvertirEnText(Counter), 1, A)
End If
End Function

’Ketik Coding dibawah ini pada Form

Option Explicit

Private Sub Text1_Change()
If Text1 <> "" Then
Text1.Text = Format(Text1, "#,##0")
Text1.SelStart = Len(Text1)
Label1.Caption = AngkaTerbilang(Text1)
Label1.Caption = StrConv(Label1, vbProperCase)
Else
Label1.Caption = ""
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyDecPt Or KeyAscii = vbKeyBack Then
Exit Sub
Else
KeyAscii = 0
End If
End Sub

Nah coba jalankan program atau tekan F5 dan isi beberapa angka pada Text1 akan secara otomatis angka terbilangnya akan ditampilkan pada Label1.

Mudah-mudahan ada mampaat nya bagi kita semua, dan jangan lupa beri komentar nya yah … sebelumnya saya ucapkan terima kasih ... wassalam