Banner Ads

Monday, June 25, 2007

Fungsi Pembilang Di Microsoft Excel Menggunakan Macro

Pembilang, ini sering kita jumpai pada kuitansi pembayaran, nota dan sebagainya. Dan sebetulnya Microsoft Excel dengan kemampuan makro-nya mampu untuk membuat fungsi seperti itu, contoh: Angka 100.000 akan diterjemahkan menjadi (Seratus Ribu Rupiah) nah supaya bisa membuat seperti itu Berikut adalah langkah-langkah untuk membuat fungsi Pembilang

  1. Bukalah program Microsoft Excel
  2. Klik menu Tool, Macro, Security
  3. Pilih Medium atau Low kemudian lalu klik OK dan tutup program Microsoft Excel
  4. Buka kembali program Microsoft Excel-nya
  5. Klik menu Tool, Macro, Visual Basic Editor atau bisa langsung teken tombol Alt+F11
  6. Setelah muncul jendelanya, klik kanan pada item VBAProject (Book1) yang terdapat pada jendela sebelah kiri
  7. Maka akan muncul menu, dari menu tersebut pilihlah Insert, Module
  8. Selanjutnya ketik script di bawah ini pada kotak isian modul tersebut (”Book1 - Module1 (Code)”) atau anda tinggal blok/select lalu copy dan paste pada kotak isian modul.

Option Explicit

Public Function UCAPANGKA(x As Double) As String
Dim tampung As Double
Dim teks As String
Dim bagian As String
Dim i As Integer
Dim tanda As Boolean

Dim letak(5)
letak(1) = "ribu "
letak(2) = "juta "
letak(3) = "milyar "
letak(4) = "trilyun "

If (x <>
UCAPANGKA = ""
Exit Function
End If

If (x = 0) Then
UCAPANGKA = "nol"
Exit Function
End If

If (x <>
tanda = True
End If
teks = ""

If (x >= 1E+15) Then
UCAPANGKA = "Nilai terlalu besar"
Exit Function
End If

For i = 4 To 1 Step -1
tampung = Int(x / (10 ^ (3 * i)))
If (tampung > 0) Then
bagian = ratusan(tampung, tanda)
teks = teks & bagian & letak(i)

End If
x = x - tampung * (10 ^ (3 * i))
Next

teks = teks & ratusan(x, False)
UCAPANGKA = teks
End Function

Function ratusan(ByVal y As Double, ByVal flag As Boolean) As String
Dim tmp As Double
Dim bilang As String
Dim bag As String
Dim j As Integer

Dim angka(9)
angka(1) = "se"
angka(2) = "dua "
angka(3) = "tiga "
angka(4) = "empat "
angka(5) = "lima "
angka(6) = "enam "
angka(7) = "tujuh "
angka(8) = "delapan "
angka(9) = "sembilan "


Dim posisi(2)
posisi(1) = "puluh "
posisi(2) = "ratus "


bilang = ""

For j = 2 To 1 Step -1
tmp = Int(y / (10 ^ j))
If (tmp > 0) Then
bag = angka(tmp)

If (j = 1 And tmp = 1) Then
y = y - tmp * 10 ^ j
If (y >= 1) Then

posisi(j) = "belas "

Else
angka(y) = "se"

End If

bilang = bilang & angka(y) & posisi(j)
ratusan = bilang
Exit Function
Else
bilang = bilang & bag & posisi(j)
End If
End If

y = y - tmp * 10 ^ j
Next

If (flag = False) Then
angka(1) = "satu "
End If
bilang = bilang & angka(y)
ratusan = bilang

End Function


Semoga berhasil...

1 comment:

Aris said...

Bagus, gua cobain tipsnya ya.
jangan lupa kunjungi blog gua ya:
http://aris-media.blogspot.com