Wednesday, May 19, 2010

Kode Program Script Terbilang

Code / Program / Script untuk merubah angka menjadi huruf. contohnya 1.000.000 menjadi satu juta rupiah.

-------------------------------------------------------- download atau copi paste aja
Public Function ubah_terbilang(xbil As Double)
Dim nilai, i, j, k, hasil$, HasilAkhir$, Bilangan#, Digit, Rp$, Bil$

If IsNull(xbil) Then
ubah_terbilang = Null
Exit Function
End If

'pengelompokan
Dim Kel$(1 To 6), Angka$(1 To 9), Sat$(1 To 3)
Kel$(1) = "Biliun "
Kel$(2) = "Triliun "
Kel$(3) = "Miliar "
Kel$(4) = "Juta "
Kel$(5) = "Ribu "
Kel$(6) = ""

'data angka
Angka$(1) = "Satu "
Angka$(2) = "Dua "
Angka$(3) = "Tiga "
Angka$(4) = "Empat "
Angka$(5) = "Lima "
Angka$(6) = "Enam "
Angka$(7) = "Tujuh "
Angka$(8) = "Delapan "
Angka$(9) = "Sembilan "

'satuan
Sat$(1) = "Ratus "
Sat$(2) = "Puluh "
Sat$(3) = ""

'mulai
Bilangan# = Val(xbil)
HasilAkhir$ = ""
GoSub HitungHuruf
If hasil$ <> "" Then
HasilAkhir$ = hasil$ + "Rupiah"
End If

'hitung pecahan
Bilangan# = Fix((Bilangan# - Fix(Bilangan#) + 0.005) * 100#)
If Bilangan# > 0 Then
GoSub HitungHuruf
If hasil$ <> "" Then
HasilAkhir$ = HasilAkhir$ + " " + hasil$ + "Sen"
End If
End If

ubah_terbilang = HasilAkhir$
Exit Function

HitungHuruf:
Rp$ = Right$(String$(18, "0") + LTrim$(Str$(Fix(Bilangan#))), 18)
hasil$ = ""

If Val(Rp$) = 0 Then Return

'blg bulat
For i = 1 To 6
Bil$ = Mid$(Rp$, i * 3 - 2, 3)

If Val(Bil$) = 1 And i = 5 Then
hasil$ = hasil$ + "Seribu "

ElseIf Val(Bil$) <> 0 Then
For j = 1 To 3
Digit = Val(Mid$(Bil$, j, 1))
If j = 2 And Right$(Bil$, 2) = "10" Then
hasil$ = hasil$ + "Sepuluh "
Exit For

ElseIf j = 2 And Right$(Bil$, 2) = "11" Then
hasil$ = hasil$ + "Sebelas "
Exit For

ElseIf j = 2 And Mid$(Bil$, 2, 1) = "1" Then
hasil$ = hasil$ + Angka$(Val(Right$(Bil$, 1))) + "Belas "
Exit For

ElseIf Digit = 1 And j = 1 Then
hasil$ = hasil$ + "Seratus "

ElseIf Digit <> 0 Then
hasil$ = hasil$ + Angka$(Digit) + Sat$(j)

End If
Next
hasil$ = hasil$ + Kel$(i)
End If
Next
Return
End Function

--------------------------------------------------------

No comments:

Post a Comment