mungkin banyak sobat yang bertanya-tanya bagaimana cara menampilkan bilangan angka dengan visual basic 6.0, 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
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
0 komentar:
Post a Comment