VBA: Number Spelling With Modified In Indonesia

Susanto3311 · Post by **Susanto3311** » 31 Jul 2022, 03:18

hi all..

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

for someone help me, greatly appreciated..
i think this not easy cause in not english

susant

Post by **HansV** » 31 Jul 2022, 06:54

It's difficult for me to test, but does this work?

Code: Select all

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!!"

   On Error Resume Next
   SeTtxt = Selection
   If Left(SeTtxt, 3) = "Rp." Then SeTtxt = Mid(SeTtxt, 4)
   If Left(SeTtxt, 2) = "Rp" Then SeTtxt = Mid(SeTtxt, 3)
   ' membalik [titik] vs [koma] jika ada
   SeTtxt = Replace(SeTtxt, ",-", ",00")
   SeTtxt = Replace(SeTtxt, ",", "\")
   SeTtxt = Replace(SeTtxt, ".", "|")
   SeTtxt = Replace(SeTtxt, "\", ".")
   SeTtxt = Replace(SeTtxt, "|", ",")

   If IsNumeric(SeTtxt) Then
      Number = CDec(SeTtxt)
      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

Susanto3311 · Post by **Susanto3311** » 31 Jul 2022, 09:43

hi hans...thanks but not fully work

after run your code
Rp100 (seratus rupiah) – it’s correct.
this below are false
Rp100,00 (sepuluh ribu rupiah) – should be (seratus rupiah)
Rp.100,00 (sepuluh ribu rupiah) – should be (seratus rupiah)
Rp.100,- (sepuluh ribu rupiah) – should be (seratus rupiah)

Note
in my country
,00 ----as decimal
,- ---- as symbol/accessories
Rp. --- as symbol/accessories

Post by **HansV** » 31 Jul 2022, 11:31

How about

Code: Select all

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!!"

   SeTtxt = Selection
   If Left(SeTtxt, 3) = "Rp." Then
      SeTtxt = Mid(SeTtxt, 4)
   ElseIf Left(SeTtxt, 2) = "Rp" Then
      SeTtxt = Mid(SeTtxt, 3)
   End If
   If Right(SeTtxt, 2) = ",-" Then
      SeTtxt = Left(SeTtxt, Len(SeTtxt) - 1) & "00"
   End If
   On Error Resume Next
   If IsNumeric(SeTtxt) Then
      With Selection
         .InsertAfter " ("
         .Collapse wdCollapseEnd
         .InsertAfter " rupiah)"
         .Collapse wdCollapseStart
      End With
      Number = CDec(SeTtxt)
      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

Susanto3311 · Post by **Susanto3311** » 31 Jul 2022, 12:19

hi hans...
i don't know what i say...but you're great!!
thank you so much.
this complete code

Code: Select all

Sub Terbilang()
    ' 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!!"

   SeTtxt = Selection
   If Left(SeTtxt, 3) = "Rp." Then
      SeTtxt = Mid(SeTtxt, 4)
   ElseIf Left(SeTtxt, 2) = "Rp" Then
      SeTtxt = Mid(SeTtxt, 3)
   End If
   If Right(SeTtxt, 2) = ",-" Then
      SeTtxt = Left(SeTtxt, Len(SeTtxt) - 1) & "00"
   End If
   On Error Resume Next
   If IsNumeric(SeTtxt) Then
      With Selection
         .InsertAfter " ("
         .Collapse wdCollapseEnd
         .InsertAfter " rupiah)"
         .Collapse wdCollapseStart
      End With
      Number = CDec(SeTtxt)
      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

Eileen's Lounge

VBA: Number Spelling With Modified In Indonesia

VBA: Number Spelling With Modified In Indonesia

Re: VBA: Number Spelling With Modified In Indonesia

Re: VBA: Number Spelling With Modified In Indonesia

Re: VBA: Number Spelling With Modified In Indonesia

Re: VBA: Number Spelling With Modified In Indonesia