RUMUS TERBILANG MS.XL

Option Explicit

'***************
' Fungsi Utama
' Mengubah Angka Menjadi Teks
' Eka Priatna
' http://priatna.or.id/
'***************

Function Terbilang(ByVal MyNumber)
    Dim Rupiah, Sen, Temp
    Dim Des, Desimal, Count, Tmp
    Dim IsNeg

    ReDim Place(9) As String
    Place(2) = "ribu "
    Place(3) = "juta "
    Place(4) = "milyar "
    Place(5) = "trilyun "

    'Ubah angka menjadi string
    MyNumber = Round(MyNumber, 2)
    MyNumber = Trim(Str(MyNumber))
   
    'Cek bilangan negatif
    If Mid(MyNumber, 1, 1) = "-" Then
        MyNumber = Right(MyNumber, Len(MyNumber) - 1)
        IsNeg = True
    End If

    'Posisi desimal, 0 jika bil. bulat
    Desimal = InStr(MyNumber, ".")
    'Pembulatan sen, dua angka di belakang koma
    Des = Mid(MyNumber, Desimal + 2)
    If Desimal > 0 Then
        Tmp = Left(Mid(MyNumber, Desimal + 1) & "00", 2)
        If Left(Tmp, 1) = "0" Then
            Tmp = Mid(Tmp, 2)
            Sen = Satuan(Tmp)
        Else
            Sen = Puluhan(Tmp)
        End If
        MyNumber = Trim(Left(MyNumber, Desimal - 1))
    End If

    Count = 1
    Do While MyNumber <> ""
       Temp = Ratusan(Right(MyNumber, 3), Count)
       If Temp <> "" Then Rupiah = Temp & Place(Count) & Rupiah
          If Len(MyNumber) > 3 Then
             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
       Else
          MyNumber = ""
       End If
       Count = Count + 1
    Loop

    Select Case Rupiah
        Case ""
            Rupiah = "nol rupiah"
        Case Else
            Rupiah = Rupiah & "rupiah"
    End Select

    Select Case Sen
        Case ""
            Sen = ""
        Case Else
            Sen = " dan " & Sen & "sen"
    End Select

    If IsNeg = True Then
        Terbilang = "minus " & Rupiah & Sen
    Else
        Terbilang = Rupiah & Sen
    End If

End Function


'**************************************
' Mengubah angka 100-999 menjadi teks *
'**************************************
Function Ratusan(ByVal MyNumber, Count)
    Dim Result As String
    Dim Tmp

    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)

    'Mengubah seribu
    If MyNumber = "001" And Count = 2 Then
        Ratusan = "se"
        Exit Function
    End If

    'Mengubah ratusan
    If Mid(MyNumber, 1, 1) <> "0" Then
        If Mid(MyNumber, 1, 1) = "1" Then
            Result = "seratus "
        Else
            Result = Satuan(Mid(MyNumber, 1, 1)) & "ratus "
        End If
    End If

    'Mengubah puluhan dan satuan
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & Puluhan(Mid(MyNumber, 2))
    Else
        Result = Result & Satuan(Mid(MyNumber, 3))
    End If

    Ratusan = Result

End Function


'*******************
' Mengubah puluhan *
'*******************
Function Puluhan(TeksPuluhan)
    Dim Result As String

    Result = ""
    ' nilai antara 10-19
    If Val(Left(TeksPuluhan, 1)) = 1 Then
        Select Case Val(TeksPuluhan)
            Case 10: Result = "sepuluh "
            Case 11: Result = "sebelas "
            Case Else
                Result = Satuan(Mid(TeksPuluhan, 2)) & "belas "
        End Select
    ' nilai antara 20-99
    Else
        Result = Satuan(Mid(TeksPuluhan, 1, 1)) _
                 & "puluh "
        Result = Result & Satuan(Right(TeksPuluhan, 1))
   'satuan
    End If
        Puluhan = Result
    End Function


'********************************
' Mengubah satuan menjadi teks. *
'********************************
Function Satuan(Digit)
    Select Case Val(Digit)
        Case 1: Satuan = "satu "
        Case 2: Satuan = "dua "
        Case 3: Satuan = "tiga "
        Case 4: Satuan = "empat "
        Case 5: Satuan = "lima "
        Case 6: Satuan = "enam "
        Case 7: Satuan = "tujuh "
        Case 8: Satuan = "delapan "
        Case 9: Satuan = "sembilan "
        Case Else: Satuan = ""
    End Select
End Function