MEMBUAT TERBILANG OTOMATIS DIEXCELL
1. Silahkan Buka Excell
2. Kemudian tekan Alt + F11
3. Pilih Insert ===> Module
4. Masukkan kode dibawah ini
Kode Untuk Rupiah
Function Terbilang(uang As Currency, Optional Sen As Boolean = True, Optional MataUang As String = "Rupiah", Optional MataUangSen As String = "Sen", Optional DuaDigitSen As Boolean = False, Optional SeparatorDesimal As String = "")
' fungsi Terbilang Versi 1.01
' copyright (c) 2013-2015, aimyaya.com
' dilarang mereproduksi, mendistribusikan atau menyebarluaskan tanpa seizin aimyaya.com
' silahkan pergunakan fungsi ini untuk keperluan perseorangan
'
' segala akibat dari penggunaan fungsi ini diluar tanggung jawab aimyaya.com
'
Dim Tingkat(0 To 4) As String
Dim sisa As Currency
Dim u As Currency
Dim ut As Currency
Dim puluhan_sen As Currency, satuan_sen As Currency
Dim st_sen As String, hasil As String
'inisialisasi variabel
Tingkat(0) = ""
Tingkat(1) = "Ribu"
Tingkat(2) = "Juta"
Tingkat(3) = "Milyar"
Tingkat(4) = "Trilyun"
If uang = 0 Then
Terbilang = "Nol " & MataUang
ElseIf uang < 0 Then
u = Abs(uang)
Terbilang = "Minus " & Terbilang(u, Sen, MataUang)
Else
st_sen = ""
u = Fix(uang)
If Sen Then
sisa = Round((uang - u) * 100)
If DuaDigitSen Then
puluhan_sen = Round(Int(sisa / 10))
satuan_sen = Round(sisa - puluhan_sen * 10)
st_sen = " " & Trim(SeparatorDesimal & " " & Trim(AngkaKeHuruf(puluhan_sen, True) & " " & AngkaKeHuruf(satuan_sen, True)) & " " & MataUangSen)
ElseIf sisa > 0 Then
st_sen = " " & Trim(SeparatorDesimal & " " & Terbilang(sisa, False, MataUangSen))
End If
End If
MataUang = " " & MataUang
hasil = ""
t = 0
While u > 0
ut = Int(u / 1000)
sisa = u - (ut * 1000)
u = ut
If sisa > 0 Then
If (sisa = 1) And (t = 1) Then
hasil = Trim("Seribu " & hasil)
Else
hasil = Trim(AngkaKeHuruf(sisa) & " " & Tingkat(t) & " " & hasil)
End If
End If
t = (t + 1) Mod 5
Wend
Terbilang = hasil & MataUang & st_sen
End If
End Function
Function AngkaKeHuruf(angka As Currency, Optional CekNol As Boolean = False)
Dim p As Currency
Dim s As Currency
Dim r As Currency
r = Int(angka / 100)
Dim angka2 As Currency
angka2 = angka - (r * 100)
'untuk ratusan
If r = 0 Then
st_r = ""
ElseIf r = 1 Then
st_r = "Seratus"
Else
st_r = AngkaKeHuruf(r) & "ratus"
End If
'untuk puluhan dan satuan
Select Case angka2
Case 0:
If CekNol = True Then
st_ps = "Nol"
Else
st_ps = ""
End If
Case 1: st_ps = "Satu"
Case 2: st_ps = "Dua "
Case 3: st_ps = "Tiga "
Case 4: st_ps = "Empat "
Case 5: st_ps = "Lima "
Case 6: st_ps = "Enam "
Case 7: st_ps = "Tujuh "
Case 8: st_ps = "Delapan "
Case 9: st_ps = "Sembilan "
Case 10: st_ps = "Sepuluh "
Case 11: st_ps = "Sebelas "
Case 12 To 19: st_ps = AngkaKeHuruf(angka2 - 10) & "belas"
Case Else
p = Int(angka2 / 10)
s = (angka2 - (p * 10))
If p = 0 Then
st_ps = AngkaKeHuruf(s)
Else
st_ps = AngkaKeHuruf(p) & "puluh" & " " & AngkaKeHuruf(s)
End If
End Select
AngkaKeHuruf = Trim(st_r & " " & st_ps)
End Function
KOde Untuk Angkas BIASA
Function Ratusan(cData As String) As String
Dim DataDepan, nLenData, nCount As Integer
Dim SisaData, cHuruf As String
Dim Satuan, Imbuhan As Variant
Satuan = Array(" nol", " satu", " dua", " tiga", " empat", " lima", " enam", " tujuh", " delapan", " sembilan")
Imbuhan = Array("", "", " puluh", " ratus")
nLenData = Len(cData)
SisaData = ""
cHuruf = ""
For nCount = nLenData To 1 Step -1
DataDepan = Val(Mid(cData, 1, 1))
SisaData = Mid(cData, 2, Len(cData))
If Not (DataDepan = 0) Then
If ((nCount = 2) And (CInt(Val(cData)) > 10) And (CInt(Val(cData)) < 20)) Then
cHuruf = cHuruf + IIf(CInt(Val(SisaData)) = 1, " se", Satuan(CInt(Val(SisaData))))
cHuruf = cHuruf + IIf(CInt(Val(SisaData)) = 1, "", " ") + "belas"
GoTo Keluar
Else
cHuruf = cHuruf + IIf((DataDepan = 1) And (Not (nCount = 1)), " se", Satuan(DataDepan)):
cHuruf = cHuruf + IIf((DataDepan = 1) And (Not (nCount = 1)), Trim(Imbuhan(nCount)), Imbuhan(nCount))
End If
End If
cData = SisaData
Next
Keluar:
Ratusan = cHuruf
End Function
Function Isi(cAngka As String) As String
Dim nCount, nLenData As Integer
Dim cHuruf, cData As String
Dim Akhiran As Variant
Akhiran = Array("", "", " ribu", " juta", " milyar", " triliun", " biliun", " ziliun")
cHuruf = ""
cData = ""
nLenData = Fix(Len(cAngka) / 3) + IIf((Len(cAngka) Mod 3) = 0, 0, 1)
For nCount = nLenData To 1 Step -1
cData = Mid(cAngka, 1, IIf(Len(cAngka) - (3 * (nCount - 1)) > 0, Len(cAngka) - (3 * (nCount - 1)), 1))
If Not (Fix(Val(cData)) = 0) Then
cHuruf = cHuruf + IIf((nCount = 2) And (CInt(Val(cData)) = 1), " se", Ratusan(cData))
cHuruf = cHuruf + IIf((nCount = 2) And (CInt(Val(cData)) = 1), Trim(Akhiran(nCount)), Akhiran(nCount))
cHuruf = Replace(cHuruf, "se ribu", "seribu")
End If
cAngka = Right(cAngka, 3 * (nCount - 1))
Next
Isi = cHuruf
End Function
Function Terbilang(nNumber As Double) As String
Dim cHuruf, cNumber, cFullNumber, cDecsNumber As String
Dim nPosDecs As Integer
If VarType(nNumber) = 2 Then
nNumber = CDbl(CStr(Fix(nNumber)) + Application.DecimalSeparator + "0")
Else
nNumber = nNumber
End If
cHuruf = ""
If nNumber < 0 Then
cHuruf = " minus"
cNumber = Trim(CStr((nNumber * -1)))
Else
cNumber = Trim(CStr(nNumber))
End If
nPosDecs = InStr(cNumber, Application.DecimalSeparator)
cFullNumber = Mid(cNumber, 1, IIf(nPosDecs = 0, Len(cNumber), nPosDecs - 1))
cDecsNumber = Right(cNumber, Len(cNumber) - IIf(nPosDecs = 0, Len(cNumber), nPosDecs))
If Not (Fix(Val(cFullNumber)) = 0) Then
cHuruf = cHuruf + Isi(CStr(cFullNumber))
Else
cHuruf = " nol"
End If
If Not (cDecsNumber = "") Then
If Not (Fix(Val(cDecsNumber)) = 0) Then
cHuruf = cHuruf + " koma" + Isi(cDecsNumber)
End If
End If
Terbilang = cHuruf
End Function
Kemudian pada lembar excell
isilah =terbilang(cell yang jd referensinya)
Jadi dech......Selamat mencoba (y)