Membuat Terbilang dengan rupiah

Dalam artikel sebelumnya kita sudah belajar cara membuat rumus terbilang secara otomatis tanpa rupiah. Untuk kali ini kita akan belajar membuat rumus terbilang yang hasilnya nanti ada rupiah. Anda masuk ke jendela VBA Macro kemudian insert Modul lalu copy paste rumus berikut :

Membuat Terbilang dengan rupiah​ dengan Kode VBA Excel

• Masuk ke Microsoft Visual Basic for Applications window dengan menekan tombol Alt + F11 atau anda klik tab "Developer" lalu klik "Visual Basic". Apabila di Office anda belum tampil tab Developer, silahkan baca "Cara Menampilkan Ribbon Developer"


• Klik Insert kemudian klik Module


• Copy Paste kode berikut di bawah ini dan masukan ke dalam module


Kode VBA Excel untuk Membuat Terbilang dengan rupiah

'https://baladaka.blogspot.com
'============================

'Fungsi Terbilang Dengan Rupiah

Public Function Terbilang(x As Currency)
    Dim triliun As Currency
    Dim milyar As Currency
    Dim juta As Currency
    Dim ribu As Currency
    Dim satu As Currency
    Dim sen As Currency
    Dim baca As String
    If x > 1000000000000# Then
       Terbilang = "https://baladaka.blogspot.com !!!"
       Exit Function
    End If
    If x < 0 Then
       x = Int(x * -1)
    End If
    'Jika x adalah 0, maka dibaca sebagai 0
    If x = 0 Then
       baca = angka(0, 1)
    Else
       'Pisah masing-masing bagian untuk triliun, milyar, juta, ribu, rupiah, dan sen
       triliun = Int(x * 0.001 ^ 4)
       milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
       juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
       ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
       satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
       sen = Int((x - Int(x)) * 100)
       'Baca bagian triliun dan ditambah akhiran triliun
       If triliun > 0 Then
          baca = ratus(triliun, 5) + "triliun "
       End If
       'Baca bagian milyar dan ditambah akhiran milyar
       If milyar > 0 Then
          baca = ratus(milyar, 4) + "milyar "
       End If
       'Baca bagian juta dan ditambah akhiran juta
       If juta > 0 Then
          baca = baca + ratus(juta, 3) + "juta "
       End If
       'Baca bagian ribu dan ditambah akhiran ribu
       If ribu > 1 Then
          baca = baca + ratus(ribu, 2) + "ribu "
       End If
       If ribu = 1 Then
          baca = baca + "seribu "
       End If
       'Baca bagian rupiah dan ditambah akhiran rupiah
       If satu > 0 Then
          baca = baca + ratus(satu, 1)
       End If
       
      'Baca bagian sen dan ditambah akhiran sen
       
       If sen >= 0 Then
          baca = baca & ratus(sen, 0) + ""
       End If


       If x >= 1 Then
          baca = baca + "rupiah "
       End If
     End If
    Terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2))
    
End Function


Function ratus(x As Currency, Posisi As Integer) As String
    Dim a100 As Integer, a10 As Integer, a1 As Integer
    Dim baca As String
    a100 = Int(x * 0.01)
    a10 = Int((x - a100 * 100) * 0.1)
    a1 = Int(x - a100 * 100 - a10 * 10)
    'Baca Bagian Ratus
    If a100 = 1 Then
       baca = "Seratus "
    Else
       If a100 > 0 Then
          baca = angka(a100, Posisi) + "ratus "
       End If
    End If
    'Baca Bagian Puluh dan Satuan
    If a10 = 1 Then
       baca = baca + angka(a10 * 10 + a1, Posisi)
    Else
       If a10 > 0 Then
          baca = baca + angka(a10, Posisi) + "puluh "
       End If
       If a1 > 0 Then
          baca = baca + angka(a1, Posisi)
       End If
    End If
    ratus = baca
End Function

Function angka(x As Integer, Posisi As Integer)
    Select Case x
        Case 0: angka = "Nihil"
        Case 1: angka = "Satu "
        Case 2: angka = "Dua "
        Case 3: angka = "Tiga "
        Case 4: angka = "Empat "
        Case 5: angka = "Lima "
        Case 6: angka = "Enam "
        Case 7: angka = "Tujuh "
        Case 8: angka = "Delapan "
        Case 9: angka = "Sembilan "
        Case 10: angka = "Sepuluh "
        Case 11: angka = "Sebelas "
        Case 12: angka = "Dua belas "
        Case 13: angka = "Tiga belas "
        Case 14: angka = "Empat belas "
        Case 15: angka = "Lima belas "
        Case 16: angka = "Enam belas "
        Case 17: angka = "Tujuh belas "
        Case 18: angka = "Delapan belas "
        Case 19: angka = "Sembilan belas "
    End Select
End Function



• Langkah selanjutnya anda membuat format untuk menempatkan terbilang tersebut, contohnya pada sebuah kuitansi. Lihat contoh dibawah ini :
  
  
  
  Sebagai contoh saya ingin membuat terbilang di sell F2 kemudian di F2 tersebut ketik rumus =terbilang(B2), dan lihat hasilnya. Anda bisa merubah angka di B2 dan lihat juga hasilnya di F2.
  
• Simpan file tersebut ke dalam type atau Save as type : Excel Macro-Enabled Workbook atau type Excel Binary Workbook

Download VBA Excel - Terbilang dengan rupiah

Download