i would help someone give me correct code /modified this code. the code commonly work properly but i want to for certainty number work too..
the code proper for spelling number in Indonesia language ..
note: in Indonesia language
mark . (dot) as separator number
mark, (comma) as mark decimal (always place in last number string)
this sample:
Rp100,00 (seratus rupiah) ~~~~~ after running code the result is correct.
Rp.100,00 (nol dan sepuluh per seratus rupiah) ---wrong result shoud be (seratus rupiah), cause adding mark . between Rp & 100
Rp100,- ( rupiah) – wrong result should be (seratus rupiah), cause contanis mark (,-). The mark (,-) always in after number last position
here the code:
Code: Select all
Option Explicit
Sub ctvTerbilang()
' retouched: awal Janari 2012
'--------------------------------------------
Dim Number As Variant, SeTtxt As Variant
Dim Kata As String, sText As String
Const Ttel As String = "ctv_Terbilang Max 18 digit!!"
' sText = Replace(Selection, Chr(10), "")
' Selection = sText
On Error Resume Next
SeTtxt = CDec(Selection)
If Not TypeName(SeTtxt) = "Decimal" Then
' membalik [titik] vs [koma] jika ada
Selection = Replace(Selection, ",", "\")
Selection = Replace(Selection, ".", "|")
Selection = Replace(Selection, "\", ".")
Selection = Replace(Selection, "|", ",")
End If
If IsNumeric(Selection) Then
Number = CDec(Selection)
With Selection
.InsertAfter " ("
.Collapse wdCollapseEnd
.InsertAfter " rupiah)"
.Collapse wdCollapseStart
End With
Select Case Number
Case 0
Kata = "Zero"
Case 0.001 To 1E+18
Kata = TERBILANG(Number)
Case Else
MsgBox "Bilangan Terlalu besar!", 48, Ttel
End Select
Else
MsgBox "Maaf, karakters yg diblok: tidak dapat dianggap sbg bilangan!!", 48, Ttel
Exit Sub
End If
Selection = Kata
End Sub
Private Function TERBILANG(Nnum As Variant) As String
'--- revisi awal jan 2012 ------------------
Dim nUtuh As Variant, nDesi As Variant
Dim sUtuh As String, sDesi As String
Nnum = CDec(Round(Nnum, 2))
nUtuh = CDec(Int(Nnum))
nDesi = CDec(Round((Nnum - nUtuh) * 100, 0))
sUtuh = TransX(nUtuh)
If nDesi = 0 Then
sDesi = ""
Else
sDesi = "dan " & TransX(nDesi) & " per seratus"
End If
TERBILANG = Trim(sUtuh & " " & sDesi)
End Function
Private Function TransX(Bilangan As Variant) As String
'--------------------------------------------
Dim TxtBil As String, Teks As String, i As Integer, Pos As Integer
Dim Angka(19) As String, Puluh(9) As String, Letak(4) As String
Dim DwiDigit As Byte, TriD1 As Byte, TriD2 As Byte, TriD3 As Byte
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":
Angka(10) = "sepuluh": Angka(11) = "sebelas": Angka(12) = "dua belas"
Angka(13) = "tiga belas": Angka(14) = "empat belas": Angka(15) = "lima belas"
Angka(16) = "enam belas": Angka(17) = "tujuh belas": Angka(18) = "delapan belas"
Angka(19) = "sembilan belas"
Puluh(0) = "": Puluh(2) = "dua puluh": Puluh(3) = "tiga puluh"
Puluh(4) = "empat puluh": Puluh(5) = "lima puluh": Puluh(6) = "enam puluh"
Puluh(7) = "tujuh puluh": Puluh(8) = "delapan puluh": Puluh(9) = "sembilan puluh"
Letak(0) = "ribu": Letak(1) = "juta"
Letak(2) = "miliar": Letak(3) = "triliun": Letak(4) = "kuadriliun"
Bilangan = CDec(Bilangan)
TxtBil = Trim(Str(Round(Abs(Bilangan), 0)))
If CDec(TxtBil) = 0 Then
Teks = "nol "
Else
i = 0
Do
TxtBil = "000" + TxtBil
DwiDigit = CByte(Right(TxtBil, 2))
If (DwiDigit > 0) And (DwiDigit < 20) Then
Teks = IIf((Bilangan < 2000 And i = 1), "se", Angka(DwiDigit) + " ") + Teks
Else
TriD3 = CByte(Right(TxtBil, 1))
If (TriD3 > 0) Then Teks = Angka(TriD3) + " " + Teks
TriD2 = CByte(Left(Right(TxtBil, 2), 1))
If (TriD2 > 0) Then Teks = Puluh(TriD2) + " " + Teks
End If
TriD1 = CByte(Left(Right(TxtBil, 3), 1))
If (TriD1 = 1) Then Teks = "seratus " + Teks
If (TriD1 > 1) Then Teks = Angka(TriD1) + " ratus " + Teks
TxtBil = Left(TxtBil, Len(TxtBil) - 3)
If (CDec(TxtBil) > 0) Then
Teks = IIf(CInt(Right(TxtBil, 3)) = 0, "", Letak(i) + " ") + Teks
i = i + 1
End If
Loop While ((CDec(TxtBil) > 0) And (i < 6))
End If
TransX = Trim(Teks)
End Function
i think this not easy cause in not english
susant