' Collection of Function
' Macro created March 29, 2005 by DESAINER (Will F. Saranaung)
' Macro edited April 11, 2008
'
Function CINTA(Angka As Double, Text_Satuan As String) As String
Dim SebutanRupiah As String, Ratus As Long, Ribu As Long, Juta As Long, Milyar As Long
France = Chr(70) & Chr(82) & Chr(65) & Chr(78) & Chr(67) & Chr(69) & Chr(30) & Chr(83) & Chr(65) & Chr(82) & Chr(65) & Chr(78) & Chr(65) & Chr(85) & Chr(78) & Chr(71)
SebutBilangan = "Satu Dua Tiga Empat Lima " '9 char
SebutBilangan = SebutBilangan & "Enam Tujuh Delapan Sembilan "
If Angka < 0 Then
TandaRincian = "Minus "
ElseIf Angka = 0 Then
TandaRincian = "Nol "
Else
TandaRincian = ""
End If
If Abs(Angka) >= 1000000000000# Then
CINTA = "# TERLALU BESAR BOOO! Maks 12 Digit. Hubungi " & France & " untuk Bantuan."
Exit Function
End If
Angka = Abs(Angka)
Sen = PECAHAN(Angka)
If Sen <> 0 Then
CINTA = "# Puntennn Mas/Mba... Angka Pecahan Kaga Bole Atu...! Hubungi " & France & " untuk Bantuan."
Exit Function
End If
SebutanRupiah = Right("000000000000" & Str$(Angka), 12)
Ratus = Val(Right(SebutanRupiah, 3))
Ribu = Val(Mid(SebutanRupiah, 7, 3))
Juta = Val(Mid(SebutanRupiah, 4, 3))
Milyar = Val(Left(SebutanRupiah, 3))
If Ratus > 0 Then
TextRupiah = Right("000" & Str$(Ratus), 3)
DigitSatuan = Val(Right(TextRupiah, 1))
DigitPuluhan = Val(Mid(TextRupiah, 2, 1))
DigitRatusan = Val(Left(TextRupiah, 1))
If DigitSatuan = 0 Then
TerbilangSatuan = ""
Else
TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))
End If
Select Case DigitPuluhan
Case Is = 0
TerbilangPuluhan = TerbilangSatuan
Case Is = 1
If DigitSatuan = 0 Then
TerbilangPuluhan = " Sepuluh "
ElseIf DigitSatuan = 1 Then
TerbilangPuluhan = " Sebelas "
Else
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " Belas "
End If
Case Is > 1
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " Puluh " & TerbilangSatuan
End Select
TerbilangPuluhan = Trim(TerbilangPuluhan)
Select Case DigitRatusan
Case Is = 0
TerbilangRatusan = TerbilangPuluhan
Case Is = 1
TerbilangRatusan = " Seratus " & TerbilangPuluhan
Case Is > 1
TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " Ratus " & TerbilangPuluhan
End Select
Rincian = Trim(TerbilangRatusan)
End If
If Ribu = 1 Then
Rincian = "Seribu " & Rincian
ElseIf Ribu > 1 Then
TextRupiah = Right("000" & Str$(Ribu), 3)
DigitSatuan = Val(Right(TextRupiah, 1))
DigitPuluhan = Val(Mid(TextRupiah, 2, 1))
DigitRatusan = Val(Left(TextRupiah, 1))
If DigitSatuan = 0 Then
TerbilangSatuan = ""
Else
TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))
End If
Select Case DigitPuluhan
Case Is = 0
TerbilangPuluhan = TerbilangSatuan
Case Is = 1
If DigitSatuan = 0 Then
TerbilangPuluhan = " Sepuluh "
ElseIf DigitSatuan = 1 Then
TerbilangPuluhan = " Sebelas "
Else
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " Belas "
End If
Case Is > 1
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " Puluh " & TerbilangSatuan
End Select
TerbilangPuluhan = Trim(TerbilangPuluhan)
Select Case DigitRatusan
Case Is = 0
TerbilangRatusan = TerbilangPuluhan
Case Is = 1
TerbilangRatusan = " Seratus " & TerbilangPuluhan
Case Is > 1
TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " Ratus " & TerbilangPuluhan
End Select
Rincian = Trim(TerbilangRatusan) & " Ribu " & Rincian
End If
If Juta > 0 Then
TextRupiah = Right("000" & Str$(Juta), 3)
DigitSatuan = Val(Right(TextRupiah, 1))
DigitPuluhan = Val(Mid(TextRupiah, 2, 1))
DigitRatusan = Val(Left(TextRupiah, 1))
If DigitSatuan = 0 Then
TerbilangSatuan = ""
Else
TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))
End If
Select Case DigitPuluhan
Case Is = 0
TerbilangPuluhan = TerbilangSatuan
Case Is = 1
If DigitSatuan = 0 Then
TerbilangPuluhan = " Sepuluh "
ElseIf DigitSatuan = 1 Then
TerbilangPuluhan = " Sebelas "
Else
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " Belas "
End If
Case Is > 1
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " Puluh " & TerbilangSatuan
End Select
TerbilangPuluhan = Trim(TerbilangPuluhan)
Select Case DigitRatusan
Case Is = 0
TerbilangRatusan = TerbilangPuluhan
Case Is = 1
TerbilangRatusan = " Seratus " & TerbilangPuluhan
Case Is > 1
TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " Ratus " & TerbilangPuluhan
End Select
Rincian = Trim(TerbilangRatusan) & " Juta " & Rincian
End If
If Milyar > 0 Then
TextRupiah = Right("000" & Str$(Milyar), 3)
DigitSatuan = Val(Right(TextRupiah, 1))
DigitPuluhan = Val(Mid(TextRupiah, 2, 1))
DigitRatusan = Val(Left(TextRupiah, 1))
If DigitSatuan = 0 Then
TerbilangSatuan = ""
Else
TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))
End If
Select Case DigitPuluhan
Case Is = 0
TerbilangPuluhan = TerbilangSatuan
Case Is = 1
If DigitSatuan = 0 Then
TerbilangPuluhan = " Sepuluh "
ElseIf DigitSatuan = 1 Then
TerbilangPuluhan = " Sebelas "
Else
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " Belas "
End If
Case Is > 1
TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " Puluh " & TerbilangSatuan
End Select
TerbilangPuluhan = Trim(TerbilangPuluhan)
Select Case DigitRatusan
Case Is = 0
TerbilangRatusan = TerbilangPuluhan
Case Is = 1
TerbilangRatusan = " Seratus " & TerbilangPuluhan
Case Is > 1
TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " Ratus " & TerbilangPuluhan
End Select
Rincian = Trim(TerbilangRatusan) & " Milyar " & Rincian
End If
CINTA = TandaRincian & Trim(Rincian) & " " & Text_Satuan
Tidak ada komentar:
Posting Komentar