Excel Macro : Mengubah Uang jadi Terbilang Rupiah

Karena suatu permintaan, penulis membuat program di bawah ini,, yaitu kode program Macro VB di Microsoft Excel untuk mengubah angka uang menjadi kalimat terbilang rupiah, misal : 1234560 menjadi Satu Juta Dua Ratus Tiga Puluh Empat Ribu Lima Ratus Enam Puluh Rupiah.

Program ini sangat berguna ketika kita membuat kuitansi.


Private Sub CommandButton1_Click()
    Range("A2").FormulaR1C1 = UCase(terbilang())
End Sub

Private Sub CommandButton2_Click()
    Range("A2").FormulaR1C1 = LCase(terbilang())
End Sub

Private Sub CommandButton3_Click()
    Range("A2").FormulaR1C1 = "=PROPER(""" & ubah(Range("A1").Value) & """)"
End Sub

Function terbilang()
'
' Terbilang Macro
' Macro recorded 20/06/2010 by erlin estiana
'

'
  Range("A2").FormulaR1C1 = ubah(Range("A1").Value)
  terbilang = ubah(Range("A1").Value)
End Function

Function satuan(inp)
    If (inp = 1) Then
        satuan = "satu "
    ElseIf (inp = 2) Then
        satuan = "dua "
    ElseIf (inp = 3) Then
        satuan = "tiga "
    ElseIf (inp = 4) Then
        satuan = "empat "
    ElseIf (inp = 5) Then
        satuan = "lima "
    ElseIf (inp = 6) Then
        satuan = "enam "
    ElseIf (inp = 7) Then
        satuan = "tujuh "
    ElseIf (inp = 8) Then
        satuan = "delapan "
    ElseIf (inp = 9) Then
        satuan = "sembilan "
    Else
        satuan = ""
    End If
End Function


Function belasan(inp)
    Dim proses
    proses = inp
    If (proses = "11") Then
        belasan = "sebelas "
    Else
        proses = Mid(proses, 2, 1)
        belasan = satuan(proses) & "belas "
    End If
End Function

Function puluhan(inp)
    Dim proses
    proses = inp
    If (proses = 1) Then
        puluhan = "sepuluh "
    ElseIf (proses = 0) Then
        puluhan = ""
    Else
        puluhan = satuan(proses) & "puluh "
    End If
End Function

Function ratusan(inp)
    Dim proses
    proses = inp
    If (proses = 1) Then
        ratusan = "seratus "
    ElseIf (proses = 0) Then
        ratusan = ""
    Else
        ratusan = satuan(proses) & "ratus "
    End If
End Function

Function ribuan(inp)
    Dim proses
    proses = inp
    If (proses = 1) Then
        ribuan = "seribu "
    ElseIf (proses = 0) Then
        ribuan = ""
    Else
        ribuan = satuan(proses) & "ribu "
    End If
End Function

Function jutaan(inp)
    Dim proses
    proses = inp
    If (proses = 0) Then
        jutaan = ""
    Else
        jutaan = satuan(proses) & "juta "
    End If
End Function

Function milyaran(inp)
    Dim proses
    proses = inp
    If (proses = 0) Then
        milyaran = ""
    Else
        milyaran = satuan(proses) & "milyar "
    End If
End Function

Function ubah(uang)
        Dim kata
    kata = ""
    Dim rp
    rp = Trim(uang)
    Dim angka
    Dim angka1
    Dim tambahan
    angka = ""
    angka1 = ""
    If (Len(rp) >= 10) Then
        angka = Mid(rp, Len(rp) + 1 - 10, 1)
        kata = kata & milyaran(angka)
    End If
    tambahan = ""
    If (Len(rp) >= 9) Then
        angka = Mid(rp, Len(rp) + 1 - 9, 1)
        kata = kata & ratusan(angka)
        If (angka > 0) Then tambahan = "juta "
    End If
    If (Len(rp) >= 8) Then
        angka = Mid(rp, Len(rp) + 1 - 8, 1)
        angka1 = Mid(rp, Len(rp) + 1 - 7, 1)
        If ((angka = 1) And (angka1 > 0)) Then
            angka = Mid(rp, Len(rp) + 1 - 8, 2)
            kata = kata & belasan(angka) & "juta "
        Else
            angka = Mid(rp, Len(rp) + 1 - 8, 1)
            kata = kata & puluhan(angka)
            If (angka > 0) Then tambahan = "juta "
            
            angka = Mid(rp, Len(rp) + 1 - 7, 1)
            kata = kata & jutaan(angka)
            If (angka = 0) Then kata = kata & tambahan
        End If
    End If
    If (Len(rp) = 7) Then
        angka = Mid(rp, Len(rp) + 1 - 7, 1)
        kata = kata & jutaan(angka)
        If (angka = 0) Then kata = kata & tambahan
    End If
    tambahan = ""
    If (Len(rp) >= 6) Then
        angka = Mid(rp, Len(rp) + 1 - 6, 1)
        kata = kata & ratusan(angka)
        If (angka > 0) Then tambahan = "ribu "
    End If
    If (Len(rp) >= 5) Then
        angka = Mid(rp, Len(rp) + 1 - 5, 1)
        angka1 = Mid(rp, Len(rp) + 1 - 4, 1)
        If ((angka = 1) And (angka1 > 0)) Then
            angka = Mid(rp, Len(rp) + 1 - 5, 2)
            kata = kata & belasan(angka) & "ribu "
        Else
            angka = Mid(rp, Len(rp) + 1 - 5, 1)
            kata = kata & puluhan(angka)
            If (angka > 0) Then tambahan = "ribu "
            
            angka = Mid(rp, Len(rp) + 1 - 4, 1)
            kata = kata & ribuan(angka)
            If (angka = 0) Then kata = kata & tambahan
        End If
    End If
    If (Len(rp) = 4) Then
        angka = Mid(rp, Len(rp) + 1 - 4, 1)
        kata = kata & ribuan(angka)
        If (angka = 0) Then kata = kata & tambahan
    End If
    If (Len(rp) >= 3) Then
        angka = Mid(rp, Len(rp) + 1 - 3, 1)
        kata = kata & ratusan(angka)
    End If
    If (Len(rp) >= 2) Then
        angka = Mid(rp, Len(rp) + 1 - 2, 1)
        angka1 = Mid(rp, Len(rp) + 1 - 1, 1)
        If ((angka = 1) And (angka1 > 0)) Then
            angka = Mid(rp, Len(rp) + 1 - 2, 2)
            kata = kata & belasan(angka)
        Else
            kata = kata & puluhan(angka)
            
            angka = Mid(rp, Len(rp) + 1 - 1, 1)
            kata = kata & satuan(angka)
        End If
    End If
    If (Len(rp) = 1) Then
        angka = Mid(rp, Len(rp) + 1 - 1, 1)
        kata = kata & satuan(angka)
    End If
    ubah = kata
End Function


File Excel nya dapat didownload di link berikut ini :

https://docs.google.com/open?id=0B4i1FYc_4RXzdTZ5eGNWZVd6ZWM

Semoga Berguna