Tips Membuat Add In Terbilang Untuk Microsoft Excel 2007 (edisi basi)

Tips Membuat Add In Terbilang Untuk Microsoft Excel 2007 (edisi basi)

Bagaimana membuat membuat Add In terbilang (menterjemahkan angka menjadi kata-kata ) pada Microsoft Excel 2007. Bagi anda yang sering membuat tanda terima pembayaran tentunya sering kali anda harus menterjemahkan angka-angka menjadi kata-kata, misal Rp. 1000,- diterjemahkan menjadi "Seribu Rupiah", tentu akan sangat melelahkan jika hal ini harus dikerjakan secara manual, dimana anda harus mengeja setiap angka pada transaksi anda untuk kemudian anda ketik. Tujuan Add In ini saya berharap akan bisa membantu mempermudah pekerjaan dalam membuat tanda terima dan mempersingkat proses.

Langkah-langkahnya sebagai berikut :
1. Copy paste kode dibawah ini pada notepad ("Terbilang dengan akhiran rupiah" atau "Terbilangan tanpa akhiran rupiah")
2. Lalu Save As dengan akhiran "terbilang.xlam" dan taruh terserah anda, contoh c:/My Documents
3. Kemuadian buka excel 2007
4. Excel Option
5.Pilih tabs "Add-Ins", lalu "Go…".
6. Muncul kotak berikut tekan pada tombol "Browse"
7. Cari file yang anda simpan tadi (misal di c:/My Documents)
8. Klik tombol "Ok" lalu akan muncul kotak berikut :
9. Klik Ok lagi untuk menyeselaikan proses pemasangan Add-Ins
Sekarang kita check apakah fungsi tersebut berfungsi. Untuk memakainya anda perlu mengetahui formulanya. Misal angka yang hendak anda buatkan terbilangnya ada di cell "A1", maka formulanya adalah sebagai berikut :
=terbilang(A1,4,"Rupiah.")
Kode Terbilang dengan akhiran rupiah :

Attribute VB_Name = "Module1"
Option Explicit

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


Kode terbilang tanpa akhiran rupiah :
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



Source : http://dhuwuh.blogspot.com/2012/08/tips-membuat-add-in-terbilang-untuk.html



Related Posts by Categories :


1280 comments:

web desain said... on September 4, 2012 at 10:17 AM  

ininya sama dengan tips membuat Add in terbilang d ms.word y gan??
ini maksimal sampe brp angka??
satu milyar or 1 trilyun bisa??

Laku.com belanja online grosir eceran murah dan aman said... on September 6, 2012 at 7:13 PM  

Ini mah bukan tips lagi, tapi artikel yang berbobot, dan sangat berkualitas. Thanks informasinya, benar-benar saya butuhkan saat ini. Semoga Tuhan membalas kebaikan Anda :)

xamthone plus said... on September 8, 2012 at 3:57 PM  

makasih untuk tips kali ini sangat sederhana sekli tapi sangat membantu saya,,, trims

Bodin Lingga said... on September 10, 2012 at 6:49 PM  

Sangat detail banget Tutorialnya,penguasaan MS Officenya benar-benar matang

management consultant said... on September 10, 2012 at 8:14 PM  

Terima kasih untuk tipsnya gan...:)
Ternyata untuk Ms. Excel ada juga untuk membuat add in terbilang...:)

Numpang promosi web gan, mohon kunjungannya:)
Management Consultant

Obat herbal ambeien said... on September 12, 2012 at 9:46 AM  

thanks buat informasi yg telah and berikan kepada saya, sangat bermanfaat sekali tuh gan :D

ukhies said... on September 12, 2012 at 10:50 AM  

sudah dikembangkan teknologi hybrid hydro yang tidak lagi menggunakan aliran sungai. teknologi ini di kembangkan oleh PT. Geo Daya Energi untuk websitenya bisa di lihat di http://www.geo-de.com

Obat Herbal Untuk kanker Tulang said... on September 16, 2012 at 4:44 PM  

terima kasih info nya :)
boleh minta rahasia tentang formula statistik di ms. excel ga gan?

Zumha Hanafi said... on September 25, 2012 at 2:54 PM  

Makasih Atas Postingannya sangat berguna banget bagi saya..
moga" blognya bisa makin berkmbang dan postingannya makin banyak...

Suhadma said... on September 25, 2012 at 2:56 PM  

makasih cing infonya, manfaat banget nih, salam kenal yah, ku tunggu nih kunjungan baliknya

Dhidhit said... on September 29, 2012 at 5:23 AM  

Terimakasih tipsnya, saya juga mempunyai tips membuat add-in terbilang excel yang bagus, klik aja pada nama saya diatas

butikonline83|Kaos couple|baju couple|Fashion said... on October 3, 2012 at 4:01 PM  

thanks gan artikelnya sangat bermanfaat, ditunggu postingan berikutnya..izin bookmark dl ya..^_^

agnisuciarini said... on October 12, 2012 at 8:38 AM  

Terimakasih atas informasinya gan semoga sukses selalu & selamat pagi.

Rey said... on October 13, 2012 at 10:38 PM  

terima kasih buat ilmu & infonya?
semoga bermanfaat bnget!
lam knal & sukses sob ?

obat tradisional herbal ace maxs said... on October 15, 2012 at 8:11 AM  

memang artikel artikel pada blog ini menakjubkan. semoga semua isi yang ada di blog ini dapat bermanfaat bagi visitor dan khususnya untuk para blogger di indonesia. Nice post

cara pemesanan jelly gamat said... on October 16, 2012 at 8:00 AM  

mantap...... makasih buat tutorialnya mas.... ditunggu tips-tips selanjutnya ya..

Blogaul said... on October 17, 2012 at 9:22 AM  

koq judul artikel nya ada kata-kata basi nya segala sih? Tapi nggak ppa lah,, nice post dan sangat membantu bagi saya.

C3C3P said... on October 20, 2012 at 11:27 AM  

Isi artikel yang sangat berguna sekali, sehingga artikel ini menjadi terpopuler. Tampilan blog yang sangat dinamis dan loading yang ringan membuat pengunjung blog betah berlama lama disini. Sehingga blog ini ramai pengunjung.

jangan lupa visit my blog.

#SalamBlogger

nyiemass said... on October 20, 2012 at 4:50 PM  

Terima kasih bos atas info-nya, sudah beberapa hari ini saya mencari informasi ini, ini sungguh sangat membantu saya untuk memecahkan masalah yang sedang saya hadapi. mulai sekarang saya akan bookmark blog ini agar saya bisa kembali dan melihat informasi yang terbaru.
mungkin si bos juga membutuh kan infomasi dari saya, trick ini akan dengan mudah membuat sebuah blog menjadi lebih maksimal dari yang sebelumnya belajar blog

Obat Alami Jerawat Batu said... on October 23, 2012 at 1:27 PM  

Terimakasih banyak gan atas inonya saya dari dulu mencari info seperti ini.
saya langsung coba saja deh.

asep sumantri said... on October 24, 2012 at 9:27 PM  

informasi yang bisajak untuk disimak mengenai tips atau cara add ini untuk microscoft exelnya gan terimakasih

obat kanker rahim herbal said... on October 30, 2012 at 9:58 PM  

ga sia sia deh mampir di blog eni ,,, jadi nambah pengetahuan

tanks bgt deh ud share

ramuan obat herbal said... on October 30, 2012 at 10:04 PM  

ini artikel bermanfaat ni, pasti pengunjung nya banyak bgt ni
saya juga jadi nambah pengetahuan ni sob

obat herbal aman said... on October 30, 2012 at 10:20 PM  

alhmdllh jadi nambah pengetahuan ni gan,,terimakasih bgt informasinya

Guruku Pahlawanku said... on November 2, 2012 at 3:39 PM  

Patut dijadikan pedoman ni mas... lumayan tambah ilmu lagi. makasih yaaa... :D

Ada info said... on November 2, 2012 at 8:32 PM  

Informasinya sangat bermanfaat, tp aku belum tertarik coz masih pakai ms.office 2003, males mau latihan hehe.

Aank budi santoso said... on November 4, 2012 at 12:16 AM  

Nice post kang ,,
wahh dapat ilmu lagi nih,,
absenn malam dulu di sini ... aahaayyy :D

Obat Tipes Herbal said... on November 5, 2012 at 2:18 PM  

makasih gan atas informasinya mengenai add ini terbilah untuk miscroscof exwlnya...untuk itu sanga senang sekali membaca artikelnya

rizuka said... on November 6, 2012 at 2:36 PM  

http://obatradisional.biz/obat-tradisional-kelenjar-getah-bening/

Lowongan Kerja Terbaru said... on November 8, 2012 at 11:19 AM  

mantraps sob...yang beginian yang ane cari dari kemarin, thanks ya sob share infonya

renovasi rumah said... on November 9, 2012 at 6:39 AM  

kalau blogspot/blog yg gratisan max PR cuma 2 yah...ada ga siy yg bisa sampai PR 4?

Obat Tradisional Gula Darah said... on November 9, 2012 at 10:31 PM  

luar biasa sekali informasi yang disajikan ini. sungguh sangat bermanfaat sekali. dan saya berharap blog ini dapat terus menerus trafiknya naik. dan jumlah visitor semakin banyak.

Post a Comment

"Using DOFOLLOW System. Pease don`t SPAM!!!"

Thanks To Comment My Articles. God Bless You People.

Add to Technorati Favorites

Technorati Ping To Your Blog
Including Yours E-Mail Address To Subscribe New Tricks