ini dapat memiliki resiko ke salahan yang cukup fatal.
oleh sebab itu kita akan membuat sebuah rumus macros pada ms word kita.
Script :
Option Explicit
Sub ctvTerbilang()
Dim Number As Variant, Kata As String, sText As String
Const Ttel As String = "Terbilang Max 18 digit saja loh!"
sText = Replace(Selection, Chr(10), "")
Selection = sText
If IsNumeric(Selection) Then
Number = CDec(Selection)
With Selection
.Copy
.EndKey Unit:=wdLine
.TypeParagraph
End With
Select Case Number
Case 0
Kata = "Zero"
Case 0.001 To 1E+18
Kata = TERBILANG(Number)
Case Else
MsgBox "Bilangan Terlalu besar!", 48, Ttel
End Select
Else
MsgBox "Tidak ada bilangan di dalam selection!!", 48, Ttel
End If
Selection = Kata
End Sub
Private Function TERBILANG(Nnum As Variant) As String
'== siti Vi <Villager.girl@Gmail.com>,=====
'== STDEV(i) <setiyowati.devi@Gmail.com>,===
'--- revisi awal jan 2012 ------------------
Dim nUtuh As Variant, nDesi As Variant
Dim sUtuh As String, sDesi As String
Nnum = CDec(Round(Nnum, 2))
nUtuh = CDec(Int(Nnum))
nDesi = CDec(Round((Nnum - nUtuh) * 100, 0))
sUtuh = TransX(nUtuh)
If nDesi = 0 Then
sDesi = ""
Else
sDesi = "dan " & TransX(nDesi) & " per seratus"
End If
TERBILANG = Trim(sUtuh & " " & sDesi)
End Function
Private Function TransX(Bilangan As Variant) As String
'== siti Vi <Villager.girl@Gmail.com>,=====
'== STDEV(i) <setiyowati.devi@Gmail.com>,===
'--------------------------------------------
Dim TxtBil As String, Teks As String, i As Integer, Pos As Integer
Dim Angka(19) As String, Puluh(9) As String, Letak(4) As String
Dim DwiDigit As Byte, TriD1 As Byte, TriD2 As Byte, TriD3 As Byte
Angka(1) = "satu": Angka(2) = "dua": Angka(3) = "tiga"
Angka(4) = "empat": Angka(5) = "lima": Angka(6) = "enam"
Angka(7) = "tujuh": Angka(8) = "delapan": Angka(9) = "sembilan":
Angka(10) = "sepuluh": Angka(11) = "sebelas": Angka(12) = "dua belas"
Angka(13) = "tiga belas": Angka(14) = "empat belas": Angka(15) = "lima belas"
Angka(16) = "enam belas": Angka(17) = "tujuh belas": Angka(18) = "delapan belas"
Angka(19) = "sembilan belas"
Puluh(0) = "": Puluh(2) = "dua puluh": Puluh(3) = "tiga puluh"
Puluh(4) = "empat puluh": Puluh(5) = "lima puluh": Puluh(6) = "enam puluh"
Puluh(7) = "tujuh puluh": Puluh(8) = "delapan puluh": Puluh(9) = "sembilan puluh"
Letak(0) = "ribu": Letak(1) = "juta"
Letak(2) = "milyar": Letak(3) = "triliun": Letak(4) = "kuadriliun"
Bilangan = CDec(Bilangan)
TxtBil = Trim(Str(Round(Abs(Bilangan), 0)))
If CDec(TxtBil) = 0 Then
Teks = "nol "
Else
i = 0
Do
TxtBil = "000" + TxtBil
DwiDigit = CByte(Right(TxtBil, 2))
If (DwiDigit > 0) And (DwiDigit < 20) Then
Teks = IIf((Bilangan < 2000 And i = 1), "se", Angka(DwiDigit) + " ") + Teks
Else
TriD3 = CByte(Right(TxtBil, 1))
If (TriD3 > 0) Then Teks = Angka(TriD3) + " " + Teks
TriD2 = CByte(Left(Right(TxtBil, 2), 1))
If (TriD2 > 0) Then Teks = Puluh(TriD2) + " " + Teks
End If
TriD1 = CByte(Left(Right(TxtBil, 3), 1))
If (TriD1 = 1) Then Teks = "seratus " + Teks
If (TriD1 > 1) Then Teks = Angka(TriD1) + " ratus " + Teks
TxtBil = Left(TxtBil, Len(TxtBil) - 3)
If (CDec(TxtBil) > 0) Then
Teks = IIf(CInt(Right(TxtBil, 3)) = 0, "", Letak(i) + " ") + Teks
i = i + 1
End If
Loop While ((CDec(TxtBil) > 0) And (i < 6))
End If
TransX = Trim(Teks) &" rupiah"
End Function
'------------------------
0 komentar:
Posting Komentar