[DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word

Sub Terbilang()
    Selection.Text = fTerbilang(Selection.Text)
End Sub

Function fTerbilang(dAngka As Variant)

‘Keterangan : Fungsi ini akan merubah angka menjadi huruf atau terbilang
‘maksimal angka adalah 999999999999.99
‘jika melebihi angka tersebut tidak akan diproses.
‘dibuat oleh: zainul_ulum@cbn.net.id
‘Rev.0: 15 Oktober 2017
    Const dMAX_NUMBER As Double = 999999999999.99
    Const sFormat As String = "000000000000.00"
    Dim arrHuruf As Variant
   
    arrHuruf = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", _
        "delapan", "sembilan", "sepuluh", "sebelas", "dua belas", "tiga belas", _
        "empat belas", "lima belas", "enam belas", "tujuh belas", "delapan belas", _
        "sembilan belas", "dua puluh", "tiga puluh", "empat puluh", "lima puluh", _
        "enam puluh", "tujuh puluh", "delapan puluh", "sembilan puluh")
   
    ‘Dim dAngka As Double
    ‘dAngka = 134912931#
   
    If dAngka > dMAX_NUMBER Then
        fTerbilang = "N/A"
        Exit Function
    End If

   
    Dim sAngka As String
   
    ‘merubah angka menjadi string
    sAngka = Format(dAngka, sFormat)
   
    Dim iRatusan As Integer, iPuluhan As Integer
    Dim idxHuruf As Integer, j As Integer, k As Integer
    Dim sTerbilang As String, sTerbilangPenuh As String
    Dim sRatusan As String, sPuluhan As String
   
    j = 1
    sTerbilangPenuh = ""
    For k = 0 To 3
    ‘angka ratusan
    iRatusan = CInt(Mid(sAngka, j, 1))
   
    ‘membaca angka Ratusan
    sRatusan = IIf(iRatusan = 0, "", arrHuruf(iRatusan) & " ratus")
   
    ‘mengganti "satu ratus" menjadi "seratus"
    sRatusan = Replace(sRatusan, "satu ratus", "seratus")
   
    ‘angka Puluhan
    iPuluhan = CInt(Mid(sAngka, j + 1, 2))
    If iPuluhan <= 19 Then
        sPuluhan = arrHuruf(iPuluhan)
    Else
        sPuluhan = arrHuruf(18 + CInt(Left(iPuluhan, 1)))
        sPuluhan = sPuluhan & " " & arrHuruf(CInt(Right(iPuluhan, 1)))
    End If
    sTerbilang = sRatusan & " " & sPuluhan
   
    ‘menambahkan kata milyar
    Select Case k
        Case 0
            sTerbilang = sTerbilang & IIf(dAngka / 1000000000# > 1, " milyar", "")
        Case 1
            sTerbilang = sTerbilang & IIf(dAngka / 1000000# > 1, " juta", "")
        Case 2
            sTerbilang = sTerbilang & IIf(dAngka / 1000# > 1, " ribu", "")
            ‘mengganti "satu ribu" menjadi "seribu"
            sTerbilang = Replace(sTerbilang, "satu ribu", "seribu")
        Case Else
            sTerbilang = sTerbilang
    End Select
    sTerbilangPenuh = sTerbilangPenuh & " " & sTerbilang
    j = j + 3
    Next k
   
    ‘membaca sen
    Dim iSen As Integer, sSen As String
    iSen = CInt(Right(sAngka, 2))
   
    If iSen <= 19 Then
            sSen = arrHuruf(iSen)
        Else
            sSen = arrHuruf(18 + CInt(Left(iSen, 1)))
            sSen = sSen & " " & arrHuruf(CInt(Right(iSen, 1)))
    End If
   
    fTerbilang = Trim(sTerbilangPenuh & IIf(iSen = 0, "", " dan " & sSen & " sen"))

End Function

Sub Spell2Number()
    Selection.Text = fSpellNumber(Selection.Text)
End Sub

Function fSpellNumber(dAngka As Variant)
   
‘Descrition : This function converts number into text or spells number into text
‘maximum number can be converted is 999999999999.99
‘Function return "N/A" if the number exceeds of the allowable maximum number
‘coded by: zainul_ulum@cbn.net.id
‘Rev.0: 15 Oktober 2017
   
   
    Const sFormat As String = "000000000000.00"
    Const dMAX_NUMBER As Double = 999999999999.99
    Dim arrHuruf As Variant
   
    arrHuruf = Array("", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", _
    "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", _
    "eighteen", "nineteen", "twenty-", "thirty-", "forty-", "fifty-", "sixty-", "seventy-", "eighty-", "ninety-")
   
    ‘Dim dAngka As Double
    ‘dAngka = 134912931#
    If dAngka > dMAX_NUMBER Then
        fSpellNumber = "N/A"
        Exit Function
    End If
   
    Dim sAngka As String
   
    ‘merubah angka menjadi string
    sAngka = Format(dAngka, sFormat)
   
    Dim iRatusan As Integer, iPuluhan As Integer
    Dim idxHuruf As Integer, j As Integer, k As Integer
    Dim sTerbilang As String, sTerbilangPenuh As String
    Dim sRatusan As String, sPuluhan As String
   
    j = 1
    sTerbilangPenuh = ""
    For k = 0 To 3
    ‘angka ratusan
    iRatusan = CInt(Mid(sAngka, j, 1))
   
    ‘membaca angka Ratusan
    sRatusan = IIf(iRatusan = 0, "", arrHuruf(iRatusan) & " hundred")
   
    ‘mengganti "satu ratus" menjadi "seratus"
    ‘sRatusan = Replace(sRatusan, "satu ratus", "seratus")
   
    ‘angka Puluhan
    iPuluhan = CInt(Mid(sAngka, j + 1, 2))
    If iPuluhan <= 19 Then
        sPuluhan = arrHuruf(iPuluhan)
    Else
        sPuluhan = arrHuruf(18 + CInt(Left(iPuluhan, 1)))
        sPuluhan = sPuluhan & arrHuruf(CInt(Right(iPuluhan, 1)))
    End If
    sTerbilang = sRatusan & " " & sPuluhan
   
    ‘menambahkan kata milyar
    Select Case k
        Case 0
            sTerbilang = sTerbilang & IIf(dAngka / 1000000000# > 1, " billion", "")
        Case 1
            sTerbilang = sTerbilang & IIf(dAngka / 1000000# > 1, " million", "")
        Case 2
            sTerbilang = sTerbilang & IIf(dAngka / 1000# > 1, " thousand", "")
            ‘mengganti "satu ribu" menjadi "seribu"
            ‘sTerbilang = Replace(sTerbilang, "satu ribu", "seribu")
        Case Else
            sTerbilang = sTerbilang
    End Select
    sTerbilangPenuh = sTerbilangPenuh & " " & sTerbilang
    j = j + 3
    Next k
   
    ‘membaca sen
    Dim iSen As Integer, sSen As String
    iSen = CInt(Right(sAngka, 2))
   
    If iSen <= 19 Then
            sSen = arrHuruf(iSen)
        Else
            sSen = arrHuruf(18 + CInt(Left(iSen, 1)))
            sSen = sSen & arrHuruf(CInt(Right(iSen, 1)))
    End If
   
    fSpellNumber = Trim(sTerbilangPenuh & IIf(iSen = 0, "", " and " & sSen & " cent" & IIf(iSen > 1, "s", "")))

End Function