Kamis, 05 Mei 2011

Fungsi Terbilang pada Microsoft Office Excel 2007

Membuat Fungsi Terbilang :
1. Buka File Excel Anda yang akan dibuat fungsi terbilang.
2. Tekan Tombol Alt+F11 = Visual Basic Editor
3. Buat modul baru Insert => Module
4. Copy kode dibawah ini ke modul tersebut (Berhubung terbatasnya ringkasan, kode saya sambung di posting selanjutnya dengan judul yang sama.
5. Tutup dan kembali ke File Excel Anda

Cara Menggunakan :
1. Letakkan Cursor pada cell yang dibuat terjemahannya.
2. Klik Formula => Insert Function
3. Di sebelah kanan "or select category" pilih User Defined kemulian OK
4. Pada kolom Nilai_Angka masukkan cell nominal yang akan diterjemahkan
5. Pada kolom Style dikosongi saja.
6. Pada kolom Satuan ketikkan "Rupiah" atau "Dollar" kemudian OK
7. Selesei

Private Function KeKata(Nomor)
TrjKata = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", "delapan", "sembilan")
KeKata = TrjKata(Nomor)
End Function

Public Function terbilang(Nilai_Angka, Optional Style = 3, Optional Satuan = "")
angka = Fix(Abs(Nilai_Angka))
'Desimal dibelakang koma
des1 = Mid(Abs(Nilai_Angka), Len(angka) + 2, 1)
des2 = Mid(Abs(Nilai_Angka), Len(angka) + 3, 1)

If des2 = "" Then
If des1 = "" Or des1 = "0" Then
Koma = ""
Else
Koma = " Koma " & KeKata(des1)
End If
ElseIf des2 = "0" Then
If des1 = "0" Then
Koma = ""
ElseIf des1 = "1" Then
Koma = " Koma Sepuluh"
Else
Koma = " Koma " & KeKata(des1) & " Puluh"
End If
Else
If des1 = "0" Then
Koma = " Koma Nol " & KeKata(des2)
ElseIf des1 = "1" Then
If des2 = "1" Then
Koma = " Koma Sebelas"
Else
Koma = " Koma " & KeKata(des2) & " Belas"
End If
Else
Koma = " Koma " & KeKata(des1) & " Puluh " & KeKata(des2)
End If
End If

No1 = Left(Right(angka, 1), 1)
No2 = Left(Right(angka, 2), 1)
No3 = Left(Right(angka, 3), 1)
No4 = Left(Right(angka, 4), 1)
No5 = Left(Right(angka, 5), 1)
No6 = Left(Right(angka, 6), 1)
No7 = Left(Right(angka, 7), 1)
No8 = Left(Right(angka, 8), 1)
No9 = Left(Right(angka, 9), 1)
No10 = Left(Right(angka, 10), 1)
No11 = Left(Right(angka, 11), 1)
No12 = Left(Right(angka, 12), 1)
No13 = Left(Right(angka, 13), 1)
No14 = Left(Right(angka, 14), 1)
No15 = Left(Right(angka, 15), 1)

If Len(angka) >= 1 Then
If Len(angka) = 1 And No1 = 1 Then
Nomor1 = "Satu"
ElseIf Len(angka) = 1 And No1 = 0 Then
Nomor1 = "Nol"
ElseIf No2 = "1" Then
If No1 = "1" Then
Nomor1 = "Sebelas"
ElseIf No1 = "0" Then
Nomor1 = "Sepuluh"
Else
Nomor1 = KeKata(No1) & " belas"
End If

Else
Nomor1 = KeKata(No1)
End If
Else
Nomor1 = ""
End If

If Len(angka) >= 2 Then
If No2 = 1 Or No2 = "0" Then
Nomor2 = ""
Else
Nomor2 = KeKata(No2) & " puluh "
End If
Else
Nomor2 = ""
End If
'Ratusan
If Len(angka) >= 3 Then
If No3 = "1" Then
Nomor3 = "Seratus "
ElseIf No3 = "0" Then
Nomor3 = ""
Else
Nomor3 = KeKata(No3) & " ratus "
End If
Else
Nomor3 = ""
End If
'Ribuan
If Len(angka) >= 4 Then
If No6 = "0" And No5 = "0" And No4 = "0" Then
Nomor4 = ""
ElseIf (No4 = "1" And Len(angka) = 4) Or (No6 = "0" And No5 = "0" And No4 = "1") Then
Nomor4 = "seribu "
ElseIf No5 = "1" Then
If No4 = "1" Then
Nomor4 = "Sebelas Ribu "
ElseIf No4 = "0" Then
Nomor4 = "Sepuluh Ribu "
Else
Nomor4 = KeKata(No4) & " belas Ribu "
End If

Else
Nomor4 = KeKata(No4) & " Ribu "
End If
Else
Nomor4 = ""
End If
'Puluhan ribu
If Len(angka) >= 5 Then
If No5 = "1" Or No5 = "0" Then
Nomor5 = ""
Else
Nomor5 = KeKata(No5) & " Puluh "
End If
Else
Nomor5 = ""
End If
'Ratusan Ribu
If Len(angka) >= 6 Then
If No6 = "1" Then
Nomor6 = "Seratus "
ElseIf No6 = "0" Then
Nomor6 = ""
Else
Nomor6 = KeKata(No6) & " ratus "
End If
Else
Nomor6 = ""
End If
'Jutaan
If Len(angka) >= 7 Then
If No9 = "0" And No8 = "0" And No7 = "0" Then
Nomor7 = ""
ElseIf No7 = "1" And Len(angka) = 7 Then
Nomor7 = "Satu Juta "
ElseIf No8 = "1" Then
If No7 = "1" Then
Nomor7 = "Sebelas Juta "
ElseIf No7 = "0" Then
Nomor7 = "Sepuluh Juta "
Else
Nomor7 = KeKata(No7) & " belas Juta "
End If


0 komentar:

Posting Komentar

Berikan Pendapat Anda!!!

Caution!!!
1. Sampaikan Komentar anda sekarang!!! Mumpung saya lagi ada waktu nge-reply ^_^