Menulis Angka Rupiah menjadi Terbilang secara Otomatis dengan Formula Excel

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


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

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
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

Selamat Mencoba ....
Selamat Bekerja ....
Semoga Bermanfaat ....
Sumber : http://sri-pamungkas.blogspot.com/2009/10/menulis-angka-rupiah-menjadi-terbilang.html
0 komentar:
Posting Komentar