Fungsi Makro Menghurufkan Angka

Fungsi lain yang disediakan oleh MS Excel untuk kita yang ingin lebih mengoptimalkan Excel adalah dengan membangun fungsi sendiri. Terkadang kita menemukan masalah yang tidak bisa diselesaikan dengan fungsi-fungsi yang sudah disediakan oleh Excel. Salah satunya adalah jika kita bermaksud untuk menghurufkan angka seperti dalam lembar kuitansi.

Setelah kita menuliskan angka tertentu, dalam lembar kuitansi atau invoice suatu transaksi biasanya akan disertai dengan sebutannya dalam tulisan (terbilang). Fungsi ini tentunya tidak disediakan oleh Excel, karena kita bermaksud untuk menuliskannya dalam bahasa Indonesia.

Oleh karena itu, kita perlu membangun fungsi tersebut sendiri. Menu yang dapat kita gunakan adalah fasilitas VBA (Visual Basic Application) yang sudah ada di Excel. Berikut adalah listingnya:

Dim Huruf(0 To 9) As String
Dim ax(0 To 3) As Double

Function INIT_angka()
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 Function

Function dgratus(angka As Double) As String
 Temp = ""
 INIT_angka
 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(angka As Double) As String
 Dim ratusan(0 To 6) As String
 Dim sebut(0 To 4) As String
 sebut(1) = " Ribu "
 sebut(2) = " Juta "
 sebut(3) = " Milyar "
 sebut(4) = " Trilyun "
 panjang = Len(Trim(Str(angka)))
 kali = Int(panjang / 3)
 If Int(panjang / 3) * 3 <> panjang Then
  kali = kali + 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 kali
  ratusan(kali - x) = Mid(nilai, x * 3 + 1, 3)
 Next x

 For y = kali 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 = Temp
End Function



Berikut adalah screeshot-nya:

Selamat mencoba.