Minggu, 22 November 2009

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

1 komentar:

  1. TERIMA KASIH BANYAK YA.
    CODE INI SANGAT MEMBANTU SAYA DALAM MEMBUAT PROGRAM. D

    BalasHapus