gandung
CAMAT
  
Age : 22
Sejak : 14 Mar 2008
Post : 1250
Lokasi : Mahkota Mas, Cikokol - Tangerang
Points :
    (100/500)
 |  Subyek: Buat yang males nerjemahin Angka ke huruf  Tue May 06, 2008 2:20 pm | |
| Mic. Excel ne.....
mau ada yang dah tau apa kagak yg penting gw post dr pd nganggur.
O' iya sebelumnya security Macro pindahin ke tingkat medium ya....
buka Visual Basic di Project Exploler Klik Kanan - Insert - Modul ( 2 x ya )
Modul pertama di isiin ini
| Quote: | 'Fungsi AgreeOnlyTInd dengan VBA untuk MS Office
'Copy By : agreeonly@yahoo.ca
'Thanks for All...
'Fungsi penterjemahan masing-masing angka
Private Function KeKata(Nomor)
TrjKata = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", "delapan", "sembilan")
KeKata = TrjKata(Nomor)
End Function
'Mulai penulisan Fungsi AgreeOnlyTInd
Public Function AgreeOnlyTInd(Nilai_Angka, Optional Style = 4, 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
'Misahin Angka
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,  , 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)
'Satuan
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
'Puluhan
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
Else
Nomor7 = KeKata(No7) & " juta "
End If
Else
Nomor7 = ""
End If
'Puluhan juta
If Len(Angka) >= 8 Then
If No8 = "1" Or No8 = "0" Then
Nomor8 = ""
Else
Nomor8 = KeKata(No8) & " puluh "
End If
Else
Nomor8 = ""
End If
'Ratusan juta
If Len(Angka) >= 9 Then
If No9 = "1" Then
Nomor9 = "seratus "
ElseIf No9 = "0" Then
Nomor9 = ""
Else
Nomor9 = KeKata(No9) & " ratus "
End If
Else
Nomor9 = ""
End If
'Milyar
If Len(Angka) >= 10 Then
If No12 = "0" And No11 = "0" And No10 = "0" Then
Nomor10 = ""
ElseIf No10 = "1" And Len(Angka) = 10 Then
Nomor10 = "satu milyar "
ElseIf No11 = "1" Then
If No10 = "1" Then
Nomor10 = "sebelas milyar "
ElseIf No10 = "0" Then
Nomor10 = "sepuluh milyar "
Else
Nomor10 = KeKata(No10) & " belas milyar "
End If
Else
Nomor10 = KeKata(No10) & " milyar "
End If
Else
Nomor10 = ""
End If
'Puluhan Milyar
If Len(Angka) >= 11 Then
If No11 = "1" Or No11 = "0" Then
Nomor11 = ""
Else
Nomor11 = KeKata(No11) & " puluh "
End If
Else
Nomor11 = ""
End If
'Ratusan Milyar
If Len(Angka) >= 12 Then
If No12 = "1" Then
Nomor12 = "seratus "
ElseIf No12 = "0" Then
Nomor12 = ""
Else
Nomor12 = KeKata(No12) & " ratus "
End If
Else
Nomor12 = ""
End If
'Triliun
If Len(Angka) >= 13 Then
If No15 = "0" And No14 = "0" And No13 = "0" Then
Nomor13 = ""
ElseIf No13 = "1" And Len(Angka) = 13 Then
Nomor13 = "satu triliun "
ElseIf No14 = "1" Then
If No13 = "1" Then
Nomor13 = "sebelas triliun "
ElseIf No13 = "0" Then
Nomor13 = "sepuluh triliun "
Else
Nomor13 = KeKata(No13) & " belas triliun "
End If
Else
Nomor13 = KeKata(No13) & " triliun "
End If
Else
Nomor13 = ""
End If
'Puluhan triliun
If Len(Angka) >= 14 Then
If No14 = "1" Or No14 = "0" Then
Nomor14 = ""
Else
Nomor14 = KeKata(No14) & " puluh "
End If
Else
Nomor14 = ""
End If
'Ratusan triliun
If Len(Angka) >= 15 Then
If No15 = "1" Then
Nomor15 = "seratus "
ElseIf No15 = "0" Then
Nomor15 = ""
Else
Nomor15 = KeKata(No15) & " ratus "
End If
Else
Nomor15 = ""
End If
If Len(Angka) > 15 Then
bilang = "Digit Angka Terlalu Banyak"
Else
If IsNull(Nilai_Angka) Then
bilang = ""
ElseIf Nilai_Angka < 0 Then
bilang = "minus " & Trim(Nomor15 & Nomor14 & Nomor13 & Nomor12 & Nomor11 & Nomor10 & Nomor9 & Nomor8 & Nomor7 _
& Nomor6 & Nomor5 & Nomor4 & Nomor3 & Nomor2 & Nomor1 & Koma & " " & Satuan)
Else
bilang = Trim(Nomor15 & Nomor14 & Nomor13 & Nomor12 & Nomor11 & Nomor10 & Nomor9 & Nomor8 & Nomor7 _
& Nomor6 & Nomor5 & Nomor4 & Nomor3 & Nomor2 & Nomor1 & Koma & " " & Satuan)
End If
End If
If Style = 4 Then
AgreeOnlyTInd = StrConv(Left(bilang, 1), 1) & StrConv(Mid(bilang, 2, 1000), 2)
Else
AgreeOnlyTInd = StrConv(bilang, Style)
End If
AgreeOnlyTInd = Replace(AgreeOnlyTInd, " ", " ", 1, 1000, vbTextCompare)
End Function
|
Modul 2 :
| Quote: |
Private Function SpellDigit(strNumeric As Integer)
Dim cRet As String
On Error GoTo Pesan
cRet = ""
Select Case strNumeric
Case 0: cRet = "zero "
Case 1: cRet = "one "
Case 2: cRet = "two "
Case 3: cRet = "three "
Case 4: cRet = "four "
Case 5: cRet = "five "
Case 6: cRet = "six "
Case 7: cRet = "seven "
Case 8: cRet = "eight "
Case 9: cRet = "nine "
Case 10: cRet = "ten "
Case 11: cRet = "eleven "
Case 12: cRet = "twelve "
Case 13: cRet = "thirteen "
Case 14: cRet = "fourteen "
Case 15: cRet = "fifteen "
Case 16: cRet = "sixteen "
Case 17: cRet = "seventeen "
Case 18: cRet = "eighteen "
Case 19: cRet = "ninetieen "
Case 20: cRet = "twenty "
Case 30: cRet = "thirty "
Case 40: cRet = "fourthy "
Case 50: cRet = "fifty "
Case 60: cRet = "sixty "
Case 70: cRet = "seventy "
Case 80: cRet = "eighty "
Case 90: cRet = "ninety "
Case 100: cRet = "one hundred "
Case 200: cRet = "two hundred "
Case 300: cRet = "three hundred "
Case 400: cRet = "four hundred "
Case 500: cRet = "five hundred "
Case 600: cRet = "six hundred "
Case 700: cRet = "seven hundred "
Case 800: cRet = "eight hundred "
Case 900: cRet = "nine hundred "
End Select
SpellDigit = cRet
Exit Function
Pesan:
SpellDigit = "(enak ya tinggal pake)"
End Function
Private Function SpellUnit(strNumeric As Integer)
Dim cRet As String
Dim n100 As Integer
Dim n10 As Integer
Dim n1 As Integer
On Error GoTo Pesan
cRet = ""
n100 = Int(strNumeric / 100) * 100
n10 = Int((strNumeric - n100) / 10) * 10
n1 = (strNumeric - n100 - n10)
If n100 > 0 Then
cRet = SpellDigit(n100)
End If
If n10 > 0 Then
If n10 = 10 Then
cRet = cRet & SpellDigit(n10 + n1)
Else
cRet = cRet & SpellDigit(n10)
End If
End If
If n1 > 0 And n10 <> 10 Then
cRet = cRet & SpellDigit(n1)
End If
SpellUnit = cRet
Exit Function
Pesan:
SpellUnit = "(enak ja tinggal pake, mau smuanya lagi)"
End Function
Public Function AgreeOnly(strNumeric As String) As String
Dim cRet As String
Dim n1000000 As Long
Dim n1000 As Long
Dim n1 As Integer
Dim n0 As Integer
On Error GoTo Pesan
Dim strValid As String, huruf As String * 1
Dim i As Integer
'Periksa setiap karakter masukan
strValid = "1234567890.,"
For i% = 1 To Len(strNumeric)
huruf = Chr(Asc(Mid(strNumeric, i%, 1)))
If InStr(strValid, huruf) = 0 Then
MsgBox "Harus karakter angka! Tolol bgt seeh BY : agreeonly@yahoo.ca", _
vbCritical, "Karakter Tidak Valid"
Exit Function
End If
Next i%
If strNumeric = "" Then Exit Function
If Len(Trim(strNumeric)) > 9 Then GoTo Pesan
cRet = ""
n1000000 = Int(strNumeric / 1000000) * 1000000
n1000 = Int((strNumeric - n1000000) / 1000) * 1000
n1 = Int(strNumeric - n1000000 - n1000)
n0 = (strNumeric - n1000000 - n1000 - n1) * 100
If n1000000 > 0 Then
cRet = SpellUnit(n1000000 / 1000000) & "million "
End If
If n1000 > 0 Then
cRet = cRet & SpellUnit(n1000 / 1000) & "thousand "
End If
If n1 > 0 Then
cRet = cRet & SpellUnit(n1)
End If
If n0 > 0 Then
cRet = cRet & " and cents" & SpellUnit(n0)
End If
AgreeOnly = cRet & "rupiah."
Exit Function
Pesan:
AgreeOnly = "(Enak aj lu! Beli, jangan cuma Make doang .:By : Didik:.)"
End Function
Private Sub txtAngka_Change()
lblTerbilang.Caption = AgreeOnly(txtAngka.Text)
End Sub
|
 |
|
dexsa
CAMAT
 
Age : 26
Sejak : 04 Apr 2008
Post : 1174
Lokasi : tangerang asline karangrejek
Points :
(4/500)
| | Subyek: Re: Buat yang males nerjemahin Angka ke huruf Fri May 09, 2008 7:06 am | |
| yup maksih makasih, tak cobane disik  |
|
bamboenk
KORLAP
Age : 21
Sejak : 25 Jun 2008
Post : 200
Lokasi : kawasan kars pegunungan seribu, tepatnya di daerah Ponjong brooo
Points :
(0/500)
| | Subyek: Re: Buat yang males nerjemahin Angka ke huruf Tue Jul 01, 2008 10:45 pm | |
| makasih mas............................ langsung coba mas.....
ters maju  |
|
mazpeyex
KORLAP
Age : 21
Sejak : 17 Jun 2008
Post : 224
Lokasi : cah semin
Points :
(0/500)
| | Subyek: Re: Buat yang males nerjemahin Angka ke huruf Wed Jul 02, 2008 3:31 am | |
| aku ya meh nyuboo iki.....matur suwun kakng  |
|
gandung
CAMAT
Age : 22
Sejak : 14 Mar 2008
Post : 1250
Lokasi : Mahkota Mas, Cikokol - Tangerang
Points :
(100/500)
| |
4lief4
KOORDINATOR
 
Age : 23
Sejak : 03 Jun 2008
Post : 463
Lokasi : njakarta
Points :
(3/500)
| | Subyek: Re: Buat yang males nerjemahin Angka ke huruf Wed Jul 02, 2008 3:17 pm | |
| | Marahi mumet ndung |
|
gandung
CAMAT
Age : 22
Sejak : 14 Mar 2008
Post : 1250
Lokasi : Mahkota Mas, Cikokol - Tangerang
Points :
(100/500)
| |
begebego
ERTE
Age : 24
Sejak : 16 May 2008
Post : 22
Lokasi : Jogja
Points :
(0/500)
| | Subyek: Re: Buat yang males nerjemahin Angka ke huruf Wed Jul 16, 2008 2:14 pm | |
| | mak nyusss.... |
|
gandung
CAMAT
Age : 22
Sejak : 14 Mar 2008
Post : 1250
Lokasi : Mahkota Mas, Cikokol - Tangerang
Points :
(100/500)
| |
Wonosingo Ngali Kidul
PENGAWAS
 
Age : 63
Sejak : 06 May 2008
Post : 3415
Lokasi : Segoro Kidul
Points :
(285/500)
| | Subyek: Re: Buat yang males nerjemahin Angka ke huruf Wed Jul 16, 2008 3:33 pm | |
| wah kowe ki malah nambahi mumet aku je ndung...  |
|
de4d10ck
KOORDINATOR
Age : 21
Sejak : 11 Aug 2008
Post : 326
Lokasi : jogja
Points :
(0/500)
| | Subyek: Re: Buat yang males nerjemahin Angka ke huruf Mon Aug 11, 2008 5:33 pm | |
| | good idea! |
|
