Rabu, 03 Oktober 2012

Menulis Angka Rupiah menjadi Terbilang secara Otomatis dengan Formula Excel


Menulis Angka Rupiah menjadi Terbilang secara Otomatis dengan Formula Excel

Anda pernah membuat laporan sederhana seperti di bawah ini ?

Dimana jumlah uang harus ditulis secara terbilang. Jika laporan yang dibuat hanya beberapa baris saja, mungkin akan dapat diselesaikan dalam waktu yang singkat. Tetapi jika laporan itu terdiri dari puluhan bahkan ratusan baris, dan kita harus mengetik secara manual jumlah uang tersebut ke dalam bentuk terbilang, maka akan memakan waktu dan tenaga yang cukup melelahkan. Berikut ada formula dalam Excel yang dapat dimanfaatkan untuk mempermudah pembuatan laporan.

Langkah Pertama :
- Masuk program Excel
- Kemudian kita masukkan formula "Terbilang" dengan meng-klik :
"Tools - Macro - Visual Basic Editor", akan muncul layar Visual Basic




























Langkah Kedua :
Setelah Muncul Layar Microsoft Visual Basic,
maka klik : "Module" seperti gambar di di samping.













Lalu akan muncul Kotak kosong seperti disamping













Langkah Ketiga :
Copy Formula di bawah ini, kemudian Paste dalam Kotak kosong (modul-1) di atas.

Option Explicit

'***************
' Fungsi Utama
' Mengubah Angka Menjadi Teks
' Sri Pamungkas
'***************

Function Terbilang(ByVal MyNumber)
Dim Rupiah, Sen, Temp
Dim Des, Desimal, Count, Tmp
Dim IsNeg

ReDim Place(9) As String
Place(2) = "ribu "
Place(3) = "juta "
Place(4) = "milyar "
Place(5) = "trilyun "

'Ubah angka menjadi string
MyNumber = Round(MyNumber, 2)
MyNumber = Trim(Str(MyNumber))

'Cek bilangan negatif
If Mid(MyNumber, 1, 1) = "-" Then
MyNumber = Right(MyNumber, Len(MyNumber) - 1)
IsNeg = True
End If

'Posisi desimal, 0 jika bil. bulat
Desimal = InStr(MyNumber, ".")
'Pembulatan sen, dua angka di belakang koma
Des = Mid(MyNumber, Desimal + 2)
If Desimal > 0 Then
Tmp = Left(Mid(MyNumber, Desimal + 1) & "00", 2)
If Left(Tmp, 1) = "0" Then
Tmp = Mid(Tmp, 2)
Sen = Satuan(Tmp)
Else
Sen = Puluhan(Tmp)
End If
MyNumber = Trim(Left(MyNumber, Desimal - 1))
End If

Count = 1
Do While MyNumber <> ""
Temp = Ratusan(Right(MyNumber, 3), Count)
If Temp <> "" Then Rupiah = Temp & Place(Count) & Rupiah
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Rupiah
Case ""
Rupiah = "nol rupiah"
Case Else
Rupiah = Rupiah & "rupiah"
End Select

Select Case Sen
Case ""
Sen = ""
Case Else
Sen = " dan " & Sen & "sen"
End Select

If IsNeg = True Then
Terbilang = "minus " & Rupiah & Sen
Else
Terbilang = Rupiah & Sen
End If

End Function


'**************************************
' Mengubah angka 100-999 menjadi teks *
'**************************************
Function Ratusan(ByVal MyNumber, Count)
Dim Result As String
Dim Tmp

If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)

'Mengubah seribu
If MyNumber = "001" And Count = 2 Then
Ratusan = "se"
Exit Function
End If

'Mengubah ratusan
If Mid(MyNumber, 1, 1) <> "0" Then
If Mid(MyNumber, 1, 1) = "1" Then
Result = "seratus "
Else
Result = Satuan(Mid(MyNumber, 1, 1)) & "ratus "
End If
End If

'Mengubah puluhan dan satuan
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & Puluhan(Mid(MyNumber, 2))
Else
Result = Result & Satuan(Mid(MyNumber, 3))
End If

Ratusan = Result

End Function


'*******************
' Mengubah puluhan *
'*******************
Function Puluhan(TeksPuluhan)
Dim Result As String

Result = ""
' nilai antara 10-19
If Val(Left(TeksPuluhan, 1)) = 1 Then
Select Case Val(TeksPuluhan)
Case 10: Result = "sepuluh "
Case 11: Result = "sebelas "
Case Else
Result = Satuan(Mid(TeksPuluhan, 2)) & "belas "
End Select
' nilai antara 20-99
Else
Result = Satuan(Mid(TeksPuluhan, 1, 1)) _
& "puluh "
Result = Result & Satuan(Right(TeksPuluhan, 1))
'satuan
End If
Puluhan = Result
End Function


'********************************
' Mengubah satuan menjadi teks. *
'********************************
Function Satuan(Digit)
Select Case Val(Digit)
Case 1: Satuan = "satu "
Case 2: Satuan = "dua "
Case 3: Satuan = "tiga "
Case 4: Satuan = "empat "
Case 5: Satuan = "lima "
Case 6: Satuan = "enam "
Case 7: Satuan = "tujuh "
Case 8: Satuan = "delapan "
Case 9: Satuan = "sembilan "
Case Else: Satuan = ""
End Select
End Function


Berikut adalah copy screen setelah formula tersebut di copy - paste ke dalam kotak kosong (modul-1)














Langkah Keempat :
Save (simpan) formula yang sudah di copy tersebut dengan cara :
- Klik gambar disket (Save)
- Pastikan Folder tempat menyimpan formula ada di folder "Add-Ins"
- Ketik Nama File, misal : "Nominal Rupiah"
- Ubah Type file menjadi (*.xla)
- Klik Save

















Langkah kelima :
- Tutup layar Visual Basic, dan buka kembali layar Excel
- Klik : "Tools - AddIns", akan muncul kotak "Add-Ins"





















Langkah Keenam :
- Setelah muncul kotak "Add-Ins", beri tanda ceklist pada nama File yang tadi disimpan
- Jika nama file yang tadi kita simpan (Nominal Rupiah), Klik Browse






















Langkah ketujuh :
- Cari folder Add-Ins, tempat file "Nominal Rupiah" di simpan
- Sorot File "Nominal Rupiah", lalu klik Ok
- Atau dapat di klik sebanyak 2x pada nama file















Langkah kedelapan :
- Setelah "Nominal Rupiah" muncul dalam kotak Add-Ins,
klik kotak kecil di depannya hingga muncul tanda ceklist
- Klik OK





















Langkah kesembilan (terakhir)


- Ketik fungsi "=terbilang(sel yang berisi nilai rupiah yang akan diubah jadi terbilang)
- Tekan Enter
- Semua angka rupiah akan ditampilkan dalam bentuk terbilang

- Fungsi "terbilang" cukup diketik sekali, dan di copy untuk angka rupiah di baris selanjutnya










sumber : http://sri-pamungkas.blogspot.com/2009/10/menulis-angka-rupiah-menjadi-terbilang.html

0 komentar: