Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis

Sering sekali kita bekerja dengan Ms. Excel dengan mengisi Manual Tulisan Terbilang dari total Angka. seperti halnya Membuat Kwitansi, Membuat Rekapitulasi, Invoice dan lain-lain. selalu ada kata terbilang dari total angka. Tetapi karena banyak nya Transaksi yang sering kita lakukan (Banyak nya Kwitansi yang dibuat setiap hari nya) sering sekali ada nya ketidak akuratan dalam memasukkan kata-kata terbilang yang tadinya adalah Rp. 1.300.000 dalam terbilang "Satu Juta Tiga Ratus Ribu Rupiah"

sering membuat kesalahan dikarenakan File yang dibuat Copy - Paste dari Workbook yang lain.

Nah sedikit ada solusi nya : Dengan Membuat Function Sendiri di Ms.Excel Fungsi Terbilang

Bagaimana Saya Membuat nya dan Menginplementasikannya ??

Mari... Yukk..!!!

Munculkan Text terbilang di Microsoft Excel

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 1

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 1

Nah Tahapannya adalah pilih Menu Tools - > Macro -> Visual Basic Editor

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 2

akan Tampil Gambar layar editor kosong dibawah ini :

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 3

kemudian Pilih Insert -> Pilih Module

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 4

hasil nya adalah
Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 5

‘Copy Mastekan Code ini di Aplikasi tempat yang kosong
‘======================================================
Option Explicit
Function KonvCurrRp(ByVal MyNumber, lRupiah As Boolean)

Dim temp
Dim Rupiah, sent
Dim PosisiDesimal, Count

ReDim Posisi(12) As String
Posisi(2) = " Ribu "
Posisi(3) = " Juta "
Posisi(4) = " Miliar "
Posisi(5) = " Triliun "

' Konversi MyNumber ke string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))

' Find Posisi desimal.
PosisiDesimal = InStr(MyNumber, ".")

' Jika ketemu Posisi desimal...
If PosisiDesimal > 0 Then
' Konversi Sent
temp = Left(Mid(MyNumber, PosisiDesimal + 1) & "00", 2)
sent = KonversiTens(temp)

' Strip off Sent dari remainder ke Konversi.
MyNumber = Trim(Left(MyNumber, PosisiDesimal - 1))
End If

' Untuk awalan Seribu
If (MyNumber < 2000) And (MyNumber > 999) Then
temp = KonversiHundreds(Right(MyNumber, 3))
Rupiah = "Seribu " & temp & Rupiah
Else
Count = 1
Do While MyNumber <> ""
' Konversi 3 digit terakhir MyNumber ke Rupiah.
temp = KonversiHundreds(Right(MyNumber, 3))
If temp <> "" Then Rupiah = temp & Posisi(Count) & Rupiah
If Len(MyNumber) > 3 Then
' Buang 3 hasil Konversi digit terakhir dari MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
End If
' Bersihkan Rupiah Rupiah.
Select Case Rupiah
Case ""
Rupiah = ""
Case "Sent"
If lRupiah Then
Rupiah = "Satu Rupiah"
Else
Rupiah = "Satu Dollar"
End If
Case Else
If lRupiah Then
Rupiah = Rupiah & " Rupiah"
Else
Rupiah = Rupiah & " Dollar"
End If
End Select

' Bersihkan Sent.
Select Case sent
Case ""
sent = ""
Case "One"
sent = " Satu Sen"
Case Else
sent = " " & sent & " Sen"
End Select

KonvCurrRp = Rupiah & sent

End Function

Private Function KonversiDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: KonversiDigit = "Satu"
Case 2: KonversiDigit = "Dua"
Case 3: KonversiDigit = "Tiga"
Case 4: KonversiDigit = "Empat"
Case 5: KonversiDigit = "Lima"
Case 6: KonversiDigit = "Enam"
Case 7: KonversiDigit = "Tujuh"
Case 8: KonversiDigit = "Delapan"
Case 9: KonversiDigit = "Sembilan"
Case Else: KonversiDigit = ""
End Select
End Function

Private Function KonversiHundreds(ByVal MyNumber)
Dim Result As String

' Jika tidak ada yang akan dikonversi Konversi.
If Val(MyNumber) = 0 Then Exit Function

' Tambahkan nol pada angka.
MyNumber = Right("000" & MyNumber, 3)

' Apakah kita punya posisi digit ratusan untuk di Konversi?
If Left(MyNumber, 1) <> "0" Then
Result = KonversiDigit(Left(MyNumber, 1)) & " Ratus "
End If

' Untuk awalan SEratus
If Left(MyNumber, 1) = "1" Then
Result = " Seratus "
End If

' Apakah kita punya Posisi digit Tens untuk di Konversi?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & KonversiTens(Mid(MyNumber, 2))
Else
' Jika tidak, Konversi the Satu Posisi digit.
Result = Result & KonversiDigit(Mid(MyNumber, 3))
End If

KonversiHundreds = Trim(Result)

End Function

Private Function KonversiTens(ByVal MyTens)
Dim Result As String

' Apakah nilai antara 10 dan 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "Sepuluh"
Case 11: Result = "Sebelas"
Case 12: Result = "Dua Belas"
Case 13: Result = "Tiga Belas"
Case 14: Result = "Empat Belas"
Case 15: Result = "Lima Belas"
Case 16: Result = "Enam Belas"
Case 17: Result = "Tujuh Belas"
Case 18: Result = "Delapan Belas"
Case 19: Result = "Sembilan Belas"
Case Else
End Select
Else
' .. selainnya, antara 20 dan 99.
Select Case Val(Left(MyTens, 1))
Case 2: Result = "Dua Puluh "
Case 3: Result = "Tiga Puluh "
Case 4: Result = "Empat Puluh "
Case 5: Result = "Lima Puluh "
Case 6: Result = "Enam Puluh "
Case 7: Result = "Tujuh Puluh "
Case 8: Result = "Delapan Puluh "
Case 9: Result = "Sembilan Puluh "
Case Else
End Select

' Konversi Posisi digit Satu.
Result = Result & KonversiDigit(Right(MyTens, 1))
End If

KonversiTens = Result

End Function

Function NumberToWord(ByVal MyNumber)
' Function untuk mengkonversi nilai dalam tipe currency
' ke bilangan rupiah.
' Disadur dari fungsi ConvertionCurrencyToDollar(ByVal MyNumber)
' Diperoleh di Internet pada site microsoft.com freedownload.

Dim temp
Dim Rupiah, sent
Dim PosisiDesimal, Count

ReDim Posisi(9) As String
Posisi(2) = " Ribu "
Posisi(3) = " Juta "
Posisi(4) = " Miliar "
Posisi(5) = " Triliun "

' Konversi MyNumber ke string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))

' Find Posisi desimal.
PosisiDesimal = InStr(MyNumber, ".")

' Jika ketemu Posisi desimal...
If PosisiDesimal > 0 Then
' Konversi Sent
temp = Left(Mid(MyNumber, PosisiDesimal + 1) & "00", 2)
sent = KonversiTens(temp)

' Strip off Sent dari remainder ke Konversi.
MyNumber = Trim(Left(MyNumber, PosisiDesimal - 1))
End If

' Untuk awalan Seribu
If (MyNumber < 2000) And (MyNumber > 999) Then
temp = KonversiHundreds(Right(MyNumber, 3))
Rupiah = "Seribu " & temp & Rupiah
Else
Count = 1
Do While MyNumber <> ""
' Konversi 3 digit terakhir MyNumber ke Rupiah.
temp = KonversiHundreds(Right(MyNumber, 3))
If temp <> "" Then Rupiah = temp & Posisi(Count) & Rupiah
If Len(MyNumber) > 3 Then
' Buang 3 hasil Konversi digit terakhir dari MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
End If
' Bersihkan Rupiah Rupiah.
Select Case Rupiah
Case ""
Rupiah = ""
Case "Sent"
Rupiah = "Satu"
Case Else
Rupiah = Rupiah
End Select

' Bersihkan Sent.
Select Case sent
Case ""
sent = ""
Case "One"
sent = " Satu"
Case Else
sent = " " & sent
End Select

NumberToWord = Rupiah & sent

End Function

‘======================================================

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 6

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 6

kemudian simpan atau tekan Ctrl + S
untuk menampilkan terbilangnya adalah

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 7

kemudian enter dah
Masukkan Rumus : =KonvCurrRp(Cell,TRUE) dalam Contoh ini =KonvCurrRp(A4,TRUE)

dah hasil nya sudah bisa ditebak.
Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 8

Tampilin tulisan Terbilang di cell Ms. Excel secara Otomatis 8

Fungsi untuk Menampilkan Kalimat Terbilang nya adalah :

=KonvCurrRp(A4,TRUE)

mana tahu gak kelihatan di gambar..!!

Silakan Mencoba.!

=KonvCurrRp(Cell,TRUE)

mas cotman....makasih buat trik nya

wah... ini baru keliatan manfaat forum nya... thanks

share ilmu dan pengetahuan... smile

betull.. betul.. betul....

ya udah Klo mau ...
temui aku di Step A Head aku ada kelas disana.
VB Net & C#
hehe tapi harus join Class di Step A Head
ntar ak ajari cara buat Program...

dipraktekin oi..
dulu gw juga ada sih yang ginian
bedanya dulu ga pake makro VB
cuma sedikit if else aja di cell nya excell langsung
tapi lupa, wahahah, bentar ubrak abrik dulu
kalo ketemu gw posting, kalo ga ketemu...
ya...

@richie.......klo g ktmu ya gt deh....... Laughing

aku juga ada yang pake Fungsi if dan sebagainya
tapi yang itu terkesan ribet dan hanya orang yang paham betul saja yang bisa buat
tadinya aku juga mau posting yang itu tapi keynya ribet bgt

akhirnya ak buat fungsi baru dengan macro VBA

nah siapun gampang mengimplementasikannya dimanapun dan kapan saja..!!

Klo ada yang mau yang pake if function boleh.. bisa aku upload..!!

saya juga punya fungsi yang pake IF THEN

gini.....>> If diketik nominal nya THEN akan muncul di display ELSE ribet banget...

he....just kidding!!!!! cool

cape deh bg umar ngeles trus...... lol!

piss

hanya itu yang bia qu lakukan kawan... lol

ada yang bilang , gak perlu pintar, tapi pintar2 aja... good job

termasuk nyusun kata2.... wkwkwkwk

wkwkwkwkkwkwkw Laughing

bisa aj bg umar ni

haha... boleh lah bang umar ...!
ya ada benar nya juga sih kita lihat dimana2 yang pinter itu selalu bekerja dibawah orang yang tidak pintar tanya kenapa ??
biasa nya seperti ini :

Orang Pinter
- selalu mencari tempat bekerja yang bonafit / bayaran mahal
- kurang berani dan penuh pertimbangan
- hanya bekerja dengan gaji stabil
- Pesimis (Menelusuri semua nya dulu baru dilakukan)
Orang dah lakukan banyak hal dia masih mikir hehe.. Very Happy

- Tipe Pekerja

Orang yang kurang pinter
- Selalu mencoba usaha
- Tampil PD
- Selalu lebih sukses
- penghasilan Tidak stabil tapi 1 M, 2 M 3, M paling kecil 500.000.000
- Optimis (lakukan dulu baru lihat hasilnya)
( Sudah kemana-mana dan banyak hasil)
-Tipe Pengusaha

Naha Saya di Tipe Orang yang kurang pinter hehe

Mas Umar tipe Orang pinter kali yah .. Very Happy

wkwkwkwkwk... lol

saya mah..... confuse3

bingung mas cotman....

tipe pekerja kagak, tipe pengusaha juga kagak.... sleepy

diserahin sama yang wahid aja sad

mudah2an dapet yang bikin hidup lebih hidupa aja lah.......

Posts : 200 Reputation : 3 Join date : 18.10.09

kalo buat di VB gimana bro....

coding & formnya jg....

Gampang Bro...
buat satu Module
Nah Kopikan Kode ini (yang ada diatas)
‘Copy Mastekan Code ini ke Module Baru
‘======================================================
Option Explicit
Function KonvCurrRp(ByVal MyNumber, lRupiah As Boolean)

Dim temp
Dim Rupiah, sent
Dim PosisiDesimal, Count

ReDim Posisi(12) As String
Posisi(2) = " Ribu "
Posisi(3) = " Juta "
Posisi(4) = " Miliar "
Posisi(5) = " Triliun "

' Konversi MyNumber ke string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))

' Find Posisi desimal.
PosisiDesimal = InStr(MyNumber, ".")

' Jika ketemu Posisi desimal...
If PosisiDesimal > 0 Then
' Konversi Sent
temp = Left(Mid(MyNumber, PosisiDesimal + 1) & "00", 2)
sent = KonversiTens(temp)

' Strip off Sent dari remainder ke Konversi.
MyNumber = Trim(Left(MyNumber, PosisiDesimal - 1))
End If

' Untuk awalan Seribu
If (MyNumber < 2000) And (MyNumber > 999) Then
temp = KonversiHundreds(Right(MyNumber, 3))
Rupiah = "Seribu " & temp & Rupiah
Else
Count = 1
Do While MyNumber <> ""
' Konversi 3 digit terakhir MyNumber ke Rupiah.
temp = KonversiHundreds(Right(MyNumber, 3))
If temp <> "" Then Rupiah = temp & Posisi(Count) & Rupiah
If Len(MyNumber) > 3 Then
' Buang 3 hasil Konversi digit terakhir dari MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
End If
' Bersihkan Rupiah Rupiah.
Select Case Rupiah
Case ""
Rupiah = ""
Case "Sent"
If lRupiah Then
Rupiah = "Satu Rupiah"
Else
Rupiah = "Satu Dollar"
End If
Case Else
If lRupiah Then
Rupiah = Rupiah & " Rupiah"
Else
Rupiah = Rupiah & " Dollar"
End If
End Select

' Bersihkan Sent.
Select Case sent
Case ""
sent = ""
Case "One"
sent = " Satu Sen"
Case Else
sent = " " & sent & " Sen"
End Select

KonvCurrRp = Rupiah & sent

End Function

Private Function KonversiDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: KonversiDigit = "Satu"
Case 2: KonversiDigit = "Dua"
Case 3: KonversiDigit = "Tiga"
Case 4: KonversiDigit = "Empat"
Case 5: KonversiDigit = "Lima"
Case 6: KonversiDigit = "Enam"
Case 7: KonversiDigit = "Tujuh"
Case 8: KonversiDigit = "Delapan"
Case 9: KonversiDigit = "Sembilan"
Case Else: KonversiDigit = ""
End Select
End Function

Private Function KonversiHundreds(ByVal MyNumber)
Dim Result As String

' Jika tidak ada yang akan dikonversi Konversi.
If Val(MyNumber) = 0 Then Exit Function

' Tambahkan nol pada angka.
MyNumber = Right("000" & MyNumber, 3)

' Apakah kita punya posisi digit ratusan untuk di Konversi?
If Left(MyNumber, 1) <> "0" Then
Result = KonversiDigit(Left(MyNumber, 1)) & " Ratus "
End If

' Untuk awalan SEratus
If Left(MyNumber, 1) = "1" Then
Result = " Seratus "
End If

' Apakah kita punya Posisi digit Tens untuk di Konversi?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & KonversiTens(Mid(MyNumber, 2))
Else
' Jika tidak, Konversi the Satu Posisi digit.
Result = Result & KonversiDigit(Mid(MyNumber, 3))
End If

KonversiHundreds = Trim(Result)

End Function

Private Function KonversiTens(ByVal MyTens)
Dim Result As String

' Apakah nilai antara 10 dan 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "Sepuluh"
Case 11: Result = "Sebelas"
Case 12: Result = "Dua Belas"
Case 13: Result = "Tiga Belas"
Case 14: Result = "Empat Belas"
Case 15: Result = "Lima Belas"
Case 16: Result = "Enam Belas"
Case 17: Result = "Tujuh Belas"
Case 18: Result = "Delapan Belas"
Case 19: Result = "Sembilan Belas"
Case Else
End Select
Else
' .. selainnya, antara 20 dan 99.
Select Case Val(Left(MyTens, 1))
Case 2: Result = "Dua Puluh "
Case 3: Result = "Tiga Puluh "
Case 4: Result = "Empat Puluh "
Case 5: Result = "Lima Puluh "
Case 6: Result = "Enam Puluh "
Case 7: Result = "Tujuh Puluh "
Case 8: Result = "Delapan Puluh "
Case 9: Result = "Sembilan Puluh "
Case Else
End Select

' Konversi Posisi digit Satu.
Result = Result & KonversiDigit(Right(MyTens, 1))
End If

KonversiTens = Result

End Function

Function NumberToWord(ByVal MyNumber)
' Function untuk mengkonversi nilai dalam tipe currency
' ke bilangan rupiah.
' Disadur dari fungsi ConvertionCurrencyToDollar(ByVal MyNumber)
' Diperoleh di Internet pada site microsoft.com freedownload.

Dim temp
Dim Rupiah, sent
Dim PosisiDesimal, Count

ReDim Posisi(9) As String
Posisi(2) = " Ribu "
Posisi(3) = " Juta "
Posisi(4) = " Miliar "
Posisi(5) = " Triliun "

' Konversi MyNumber ke string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))

' Find Posisi desimal.
PosisiDesimal = InStr(MyNumber, ".")

' Jika ketemu Posisi desimal...
If PosisiDesimal > 0 Then
' Konversi Sent
temp = Left(Mid(MyNumber, PosisiDesimal + 1) & "00", 2)
sent = KonversiTens(temp)

' Strip off Sent dari remainder ke Konversi.
MyNumber = Trim(Left(MyNumber, PosisiDesimal - 1))
End If

' Untuk awalan Seribu
If (MyNumber < 2000) And (MyNumber > 999) Then
temp = KonversiHundreds(Right(MyNumber, 3))
Rupiah = "Seribu " & temp & Rupiah
Else
Count = 1
Do While MyNumber <> ""
' Konversi 3 digit terakhir MyNumber ke Rupiah.
temp = KonversiHundreds(Right(MyNumber, 3))
If temp <> "" Then Rupiah = temp & Posisi(Count) & Rupiah
If Len(MyNumber) > 3 Then
' Buang 3 hasil Konversi digit terakhir dari MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
End If
' Bersihkan Rupiah Rupiah.
Select Case Rupiah
Case ""
Rupiah = ""
Case "Sent"
Rupiah = "Satu"
Case Else
Rupiah = Rupiah
End Select

' Bersihkan Sent.
Select Case sent
Case ""
sent = ""
Case "One"
sent = " Satu"
Case Else
sent = " " & sent
End Select

NumberToWord = Rupiah & sent

End Function

‘======================================================

Misal
Textbox1.text =1000

kita mau masukkan nilai terbilang ke textbox2.text

Nah Caranya sama

di Event Form_Load nya Buah Code ini

TextBox1.Text =1000
TextBox2.Text = KonvCurrRp(ccur(TextBox1.Text),TRUE)

sebenarnya Code yang diatas aku buat di VB dan Aku implementasikan di Ms. Access dan Ms. Excel

Selamat Mencoba Bro...

Sory bro...
Lagi sibuk bener nih... klo masih bingung nanti saya post yang lengkapnya beserta Form nya Smile

Posts : 200 Reputation : 3 Join date : 18.10.09

thx..... bro....
sdh sgt membantu...