'*******************************************************************
'* Spell Number to Word Indonesian Version
'* for VB language
'*******************************************************************
'* Original Source Program by : Ady Suryanto
'* Midified by Agung Waspo Widodo
'* Created at June 22th 2005
'* This Function is Free
'* Please do not use for commercial
'*******************************************************************
'*******************************************************************
'* Modified :
'* - Check the decimal but not spell
'*******************************************************************
Public Function TBilRupiah(strAngka As String) As String
Dim strJmlHuruf As String
Dim strPecahan As String
Dim Urai As String
Dim Bil1 As String
Dim strTot As String
Dim Bil2 As String
Dim intPecahan, i, Digitke As Integer
Dim adaDesimal As Boolean
Dim BacaAngka As String
Dim Desimalnya As String
Dim X, y, z As Integer
'--Cek Desimal dengan catatan bahwa regional sudah paten Indonesian bo.......
adaDesimal = False
For i = 1 To 16
If Mid(strAngka, i, 1) = "," Then
adaDesimal = True
digitke = Len(strAngka) - i
End If
Next
'--end of Cek Desimal
If strAngka = "" Or Len(strAngka) > 16 Then Exit Function
'---Starting to separate desimal
If adaDesimal Then
Desimalnya = Right(strAngka, digitke)
BacaAngka = Mid(strAngka, 1, Len(strAngka) - (digitke + 1))
strAngka = BacaAngka
End If
'---end of Starting to separate desimal
strJmlHuruf = LTrim(strAngka)
intPecahan = Val(Right(Mid(strAngka, 16, 2), 2))
If (intPecahan = 0) Then
strPecahan = ""
Else
strPecahan = LTrim(Str(intPecahan)) + "/100 "
End If
X = 0
y = 0
Urai = ""
While (X < Len(strJmlHuruf))
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
y = y + Val(strTot)
z = Len(strJmlHuruf) - X + 1
Select Case Val(strTot)
Case 1
If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then
Bil1 = "Satu "
ElseIf (z = 4) Then
If (X = 1) Then
Bil1 = "Se"
Else
Bil1 = "Satu "
End If
ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
z = Len(strJmlHuruf) - X + 1
Bil2 = ""
Select Case Val(strTot)
Case 0
Bil1 = "Sepuluh "
Case 1
Bil1 = "Sebelas "
Case 2
Bil1 = "Dua Belas "
Case 3
Bil1 = "Tiga Belas "
Case 4
Bil1 = "Empat Belas "
Case 5
Bil1 = "Lima Belas "
Case 6
Bil1 = "Enam Belas "
Case 7
Bil1 = "Tujuh Belas "
Case 8
Bil1 = "Delapan Belas "
Case 9
Bil1 = "Sembilan Belas "
End Select
Else
Bil1 = "Se"
End If
Case 2
Bil1 = "Dua "
Case 3
Bil1 = "Tiga "
Case 4
Bil1 = "Empat "
Case 5
Bil1 = "Lima "
Case 6
Bil1 = "Enam "
Case 7
Bil1 = "Tujuh "
Case 8
Bil1 = "Delapan "
Case 9
Bil1 = "Sembilan "
Case Else
Bil1 = ""
End Select
If (Val(strTot) > 0) Then
If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
Bil2 = "Puluh "
ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then
Bil2 = "ratus "
Else
Bil2 = ""
End If
Else
Bil2 = ""
End If
If (y > 0) Then
Select Case z
Case 4
Bil2 = Bil2 + "Ribu "
y = 0
Case 7
Bil2 = Bil2 + "Juta "
y = 0
Case 10
Bil2 = Bil2 + "Milyar "
y = 0
Case 13
Bil2 = Bil2 + "Trilyun "
y = 0
End Select
End If
Urai = Urai + Bil1 + Bil2
Wend
Urai = Urai + strPecahan
TBilRupiah = "# " & Urai & "Rupiah #"
End Function
'*******************************************************************
'* Spell Number to Word US English Version
'* for VB language
'*******************************************************************
'* Original Source Program by : Ady Suryanto
'* Midified by Agung Waspo Widodo
'* Created at June 22th 2005
'* This Function is Free (anyone can modified)
'* Please do not use for commercial
'*******************************************************************
'*******************************************************************
'* Modified :
'* - Check the decimal and spell it
'*******************************************************************
Public Function TbilDollar(strAngka As String) As String
Dim strJmlHuruf As String
Dim strPecahan As String
Dim Urai As String
Dim Bil1 As String
Dim strTot As String
Dim Bil2 As String
Dim intPecahan, i, Digitke As Integer
Dim adaDesimal As Boolean
Dim BacaAngka As String
Dim Desimalnya As String
Dim X, y, z As Integer
'--Cek Desimal bo.......
adaDesimal = False
For i = 1 To 16
If Mid(strAngka, i, 1) = "," Then
adaDesimal = True
digitke = Len(strAngka) - i
End If
Next
'--end of Cek Desimal
If strAngka = "" Or Len(strAngka) > 16 Then Exit Function
'---Starting to separate desimal
If adaDesimal Then
Desimalnya = Right(strAngka, digitke)
BacaAngka = Mid(strAngka, 1, Len(strAngka) - (digitke + 1))
strAngka = BacaAngka
End If
'---end of Starting to separate desimal
strJmlHuruf = LTrim(strAngka)
intPecahan = Val(Right(Mid(strAngka, 16, 2), 2))
If (intPecahan = 0) Then
strPecahan = ""
Else
strPecahan = LTrim(Str(intPecahan)) + "/100 "
End If
X = 0
y = 0
Urai = ""
While (X < Len(strJmlHuruf))
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
y = y + Val(strTot)
z = Len(strJmlHuruf) - X + 1
Select Case Val(strTot)
Case 1
If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then
Bil1 = "One "
ElseIf (z = 4) Then
If (X = 1) Then
Bil1 = "One "
Else
Bil1 = "One "
End If
ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
z = Len(strJmlHuruf) - X + 1
Bil2 = ""
Select Case Val(strTot)
Case 0
Bil1 = "Ten "
Case 1
Bil1 = "Eleven "
Case 2
Bil1 = "Twelve "
Case 3
Bil1 = "Thirteen "
Case 4
Bil1 = "Fourteen "
Case 5
Bil1 = "Fifteen "
Case 6
Bil1 = "Sixteen "
Case 7
Bil1 = "Seventeen "
Case 8
Bil1 = "Eighteen "
Case 9
Bil1 = "Nineteen "
End Select
Else
Bil1 = "One "
End If
Case 2
Bil1 = "Two "
Case 3
Bil1 = "Three "
Case 4
Bil1 = "Four "
Case 5
Bil1 = "Five "
Case 6
Bil1 = "Six "
Case 7
Bil1 = "Seven "
Case 8
Bil1 = "Eight "
Case 9
Bil1 = "Nine "
Case Else
Bil1 = ""
End Select
If (Val(strTot) > 0) Then
If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
Select Case Val(strTot)
Case 2
Bil1 = "Twenty "
Case 3
Bil1 = "Thirty "
Case 4
Bil1 = "Fourty "
Case 5
Bil1 = "Fifty "
Case 6
Bil1 = "Sixty "
Case 7
Bil1 = "Seventy "
Case 8
Bil1 = "Eighty "
Case 9
Bil1 = "Ninety "
End Select
End If
If (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then
Bil2 = "Hundred "
Else
Bil2 = ""
End If
Else
Bil2 = ""
End If
If (y > 0) Then
Select Case z
Case 4
Bil2 = Bil2 + "Thousand "
y = 0
Case 7
Bil2 = Bil2 + "Million "
y = 0
Case 10
Bil2 = Bil2 + "Billion "
y = 0
Case 13
Bil2 = Bil2 + "Trillion "
y = 0
End Select
End If
Urai = Urai + Bil1 + Bil2
Wend
Urai = Urai + strPecahan
'---ucap desimal
X = 0
y = 0
UraiDesimal = ""
If Len(Desimalnya) = 1 Then Desimalnya = Desimalnya + "0"
While (X < Len(Desimalnya))
X = X + 1
strTot = Mid(Desimalnya, X, 1)
y = y + Val(strTot)
z = Len(Desimalnya) - X + 1
Select Case Val(strTot)
Case 1
If (z = 1) Then
Bil1 = "One "
ElseIf (z = 4) Then
If (X = 1) Then
Bil1 = "One "
End If
ElseIf (z = 2) Then
X = X + 1
strTot = Mid(Desimalnya, X, 1)
z = Len(Desimalnya) - X + 1
Bil2 = ""
Select Case Val(strTot)
Case 0
Bil1 = "Ten "
Case 1
Bil1 = "Eleven "
Case 2
Bil1 = "Twelve "
Case 3
Bil1 = "Thirteen "
Case 4
Bil1 = "Fourteen "
Case 5
Bil1 = "Fifteen "
Case 6
Bil1 = "Sixteen "
Case 7
Bil1 = "Seventeen "
Case 8
Bil1 = "Eighteen "
Case 9
Bil1 = "Nineteen "
End Select
End If
Case 2
Bil1 = "Two "
Case 3
Bil1 = "Three "
Case 4
Bil1 = "Four "
Case 5
Bil1 = "Five "
Case 6
Bil1 = "Six "
Case 7
Bil1 = "Seven "
Case 8
Bil1 = "Eight "
Case 9
Bil1 = "Nine "
Case Else
Bil1 = ""
End Select
If (Val(strTot) > 0) Then
If (z = 2) Then
Select Case Val(strTot)
Case 2
Bil1 = "Twenty "
Case 3
Bil1 = "Thirty "
Case 4
Bil1 = "Fourty "
Case 5
Bil1 = "Fifty "
Case 6
Bil1 = "Sixty "
Case 7
Bil1 = "Seventy "
Case 8
Bil1 = "Eighty "
Case 9
Bil1 = "Ninety "
Case Else
Bil1 = ""
End Select
Else
Bil2 = ""
End If
Else
Bil2 = ""
End If
UraiDesimal = UraiDesimal + Bil1 + Bil2
Wend
'end of ucap desimal
If adaDesimal Then
TbilDollar = "# " & Urai & "US Dollar " + UraiDesimal + "Cent #"
Else
TbilDollar = "# " & Urai & "US Dollar #"
End If
End Function