RUMUS KONVERSI ANGKA KE HURUF

Function AngkaToTeks(lnAngka) As String
Dim lcOldAngka As String
Dim lcAngka As String
Dim lcAmt As String
Dim lcTeks As String
Dim i As Integer

i = 0
lcAmt = ""
lcTeks = "Satu Dua Tiga Empat Lima Enam Tujuh Delapan Sembilan"

lcOldAngka = Trim(Str(Round(lnAngka, 0)))

' Angka 12 menandakan panjang maksimal 12 digit.
lcOldAngka = Space(12 - Len(lcOldAngka)) & lcOldAngka

' 3 berarti looping sebanyak 4 kali, karena AngkaToTeks ini sampai
' miliar-an.
' contoh: 123.456.789.012
' 0 1 2 3
For i = 0 To 3

lcAngka = Mid(lcOldAngka, i * 3 + 1, 3)

If Not (Trim(lcAngka) = "") And Val(lcAngka) > 0 Then

If Mid(lcAngka, 1, 1) = "1" Then
lcAmt = lcAmt + " Seratus "
End If

If Mid(lcAngka, 1, 1) > "1" Then
lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 1, 1)) * 8 - 7, 8)) + " Ratus "
End If

If Mid(lcAngka, 2, 1) = "1" Then
Select Case Mid(lcAngka, 3, 1)
Case "0"
lcAmt = lcAmt + " Sepuluh "
Case "1"
lcAmt = lcAmt + " Sebelas "
Case Is > "1"
lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8)) + " Belas "
End Select
End If

If Mid(lcAngka, 2, 1) > "1" Then
lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 2, 1)) * 8 - 7, 8)) + " Puluh "
If Mid(lcAngka, 3, 1) > "0" Then
lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8))
End If
End If

If Mid(lcAngka, 2, 1) = "0" And Mid(lcAngka, 3, 1) > "0" Then
lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8))
End If

If Mid(lcAngka, 1, 2) = " " And Mid(lcAngka, 3, 1) > "0" Then
lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8))
End If

If i = 0 Then
lcAmt = lcAmt + " Miliar "
End If

If i = 1 Then
lcAmt = lcAmt + " Juta "
End If

If i = 2 Then
lcAmt = lcAmt + " Ribu "
End If

End If

Next

If Not lcAmt = "" Then
AngkaToTeks = lcAmt + " Rupiah"
Else
AngkaToTeks = "Nol Rupiah"
End If

End Function

Sub Terbilang()
If Len(Range("D7").Value) <= 12 Then
Range("B9").Value = "// " & AngkaToTeks(Range("D7").Value) & " //"
Else
MsgBox "Maksimal 12 Digit"
Application.Undo
End If
End Sub




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("D7").Value <> Range("AA1000").Value Then
Terbilang
Range("AA1000").Value = Range("D7").Value
End If
End Sub





CATATAN :
TEKS WARNA MERAH DISESUAIKAN DENGAN KEPERLUAN DIMANA POSISI ANGKA DAN HURUF TERBILANG AKAN DITEMPATKAN (RANGE) PADA MICROSOFT EXCEL