Jumat, 21 September 2012

CARA MEMBUAT FUNGSI "TERBILANG" DI MS. EXCEL



A. Membuat Module 
1. Buka microsoft Excel 
2. Buka Menu Tools - Macro - Visual Basic Editor 
3. Buat module baru dengan cara : Klik menu Insert - Module 
4. Masukkan (Copy-Paste) fungsi terbilang berikut ini : 

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 
'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 > 0 Then 
baca = baca + ratus(ribu, 2) + "ribu " 
End If 
'Baca bagian satuan 
If satu > 0 Then 
baca = baca + ratus(satu, 1) + "rupiah " 
Else 
baca = baca + "rupiah " 
End If 
'Baca bagian sen dan ditambah akhiran sen 
If sen > 0 Then 
baca = baca + ratus(sen, 0) + "sen " 
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, 2) + "ratus " 
End If 
End If 
'Baca Bagian Puluh dan Satuan 
If a10 = 1 Then 
baca = baca + angka(a10 * 10 + a1, 2) 
Else 
If a10 > 0 Then 
baca = baca + angka(a10, 2) + "puluh " 
End If 
If a1 > 0 Then 
If posisi = 2 And a100 = 0 And a10 = 0 Then 
baca = baca + angka(a1, 1) 
Else 
baca = baca + angka(a1, 2) 
End If 
End If 
End If 
ratus = baca 
End Function 
Function angka(x As Integer, posisi As Integer) 
Select Case x 
Case 0: angka = "Nol" 
Case 1: 
If posisi = 2 Then 
angka = "Satu " 
Else 
angka = "Se" 
End If 
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 


5. Lakukan proses pengecekan pada lembar sheet Excel. 
Contoh : - Ketik angka 1000 pada sel B2. 
- Pada sel B3, ketik fungsi =terbilang(B2) 
- Jika pada sel B3 berubah menjadi "seribu rupiah" , maka fungsi diatas telah benar 


B. Membuat Deskripsi Fungsi 
1. Pada lembar kerja Excel, klik menu Tools - Macros 
2. Ketikkan nama fungsi terbilang dan pastikan tombol Option menyala 
3. Klik Option, dan ketik Deskripsi fungsi terbilang anda pada kotak Descripsion
4. Klik OK 

C. Membuat Add Ins 
1. Tutup Visual Basic Editor 
2. Simpan Dokumen Excel dengan klik menu File - Save As 
3. Ubah Save As Type menjadi Microsoft Excel Add In (*.xla) 
4. Beri nama bebas, misal : terbilang.xla 
5. Klik OK 

D. Menginstall Add-In 
1. Buka Menu Tools - Add Ins 
2. Pilih dan centang pilihan "terbilang" pada list Add Ins 
3. Klik OK 




Proses selesai...Fungsi dapat digunakan !!! 
Selamat Mencoba !!!


Tidak ada komentar:

Posting Komentar