Module Terbilang Automatis Di Excel

Tinggal masuk ke menu developer kemudian pilih visual basic.

Copy dan Paste Code sebagai berikut :
Dim Huruf(0 To 9) As String
Dim AX(0 To 3) As Double

Public Sub InitAngka()
    Huruf(0) = ""
    Huruf(1) = "satu "
    Huruf(2) = "dua "
    Huruf(3) = "tiga "
    Huruf(4) = "empat "
    Huruf(5) = "lima "
    Huruf(6) = "enam "
    Huruf(7) = "tujuh "
    Huruf(8) = "delapan "
    Huruf(9) = "sembilan "
End Sub

Public Function DgRatus(ByVal A As Double) As String
Dim Angka As Long

Angka = Int(A)
temp = ""
InitAngka

panjang = Len(Trim(Str(Angka)))
nilai = Right("000", 3 - panjang) & Trim(Str(Angka))

For y = 3 To 1 Step -1
    AX(y) = Mid(nilai, y, 1)
    Next y

Select Case AX(1)
    Case Is = 1
        temp = "seratus "
    Case Is > 1
        temp = Huruf(Val(AX(1))) & "" & "ratus "
    Case Else
        temp = ""
End Select

Select Case AX(2)
    Case Is = 0
        temp = temp & Huruf(Val(AX(3)))
    Case Is = 1
        Select Case AX(3)
            Case Is = 1
            temp = temp & "sebelas "
            Case Is = 0
            temp = temp & "sepuluh "
    Case Else
        temp = temp & Huruf(Val(AX(3))) & "belas "
End Select
Case Is > 1
    temp = temp & Huruf(Val(AX(2))) & "puluh "
    temp = temp & "" & Huruf(Val(AX(3)))
End Select
DgRatus = temp
End Function

Function DgHuruf(A As Double) As String
    Dim Ratusan(0 To 6) As String
    Dim Sebut(0 To 4) As String
    Dim Koma As String
    Dim Angka As Double
    Dim AAA As String
   
    On Error GoTo salah
    Koma = Format(A, "##############0.#0")
Angka = A - (Val(Right(Koma, 2)) / 100)
Sebut(1) = "ribu "
Sebut(2) = "juta "
Sebut(3) = "milyar "
Sebut(4) = "triliun "

panjang = Len(Trim(Str(Angka)))
Kl = Int(panjang / 3)
If Int(panjang / 3) * 3 <> panjang Then
    Kl = Kl + 1
    sisa = panjang - Int(panjang / 3) * 3
    nilai = Right("000", 3 - sisa) & Trim(Str(Angka))
Else
    nilai = Trim(Str(Angka))
End If

For x = 0 To Kl
    Ratusan(Kl - x) = Mid(nilai, x * 3 + 1, 3)
Next x

For y = Kl To 1 Step -1
    If y = 2 And Val(Ratusan(y)) = 1 Then
        temp = temp & "seribu "
    Else
        If Val(Ratusan(y)) = 0 Then
            temp = temp
        Else
            temp = temp & DgRatus(Val(Ratusan(y)))
            temp = temp & Sebut(y - 1)
        End If
    End If
Next y

DgHuruf = UCase(Left(temp, 1)) & Mid(temp, 2, Len(temp) - 1)

Koma = Format(A, "##############0.#0")

If Right(Koma, 2) = "00" Then
    DgHuruf = DgHuruf
Else
    If Val(Right(Koma, 2)) < 10 Then
        DgHuruf = DgHuruf & " " & Right(Koma, 1) & "/100 "
    Else
        DgHuruf = DgHuruf & " " & Right(Koma, 2) & "/100 "
    End If
End If
DgHuruf = DgHuruf & "rupiah,-"
Exit Function
salah:
MsgBox "Kata Ferdinan S, Terjadi Kesalahan" & vbCr & vbCr & _
        Err.Description & vbCr & Err.Number & vbCr & Err.Source, vbCritical, "KESALAHAN"
End Function



Note : Cara panggil pada kolom formula ketik "DgHuruf(NAMAKOLOM)".