Seni Belajar Pemrograman Visual: Function Terbilang by France

Rabu, 08 September 2010

Function Terbilang Berbahasa Indonesia pada Excel dengan VbScript.

' 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

End Function

Baca selengkapnya »

Function Terbilang berbahasa inggris pada excel dengan vbscript

Function LAMU(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 = "One Two Three Four Five Six Seven Eight Nine " ' 6 char
   SebutBilanganBelas = "Eleven Twelve Thirteen Fourteen Fifteen Dixteen Seventeen Eighteen Nineteen " '10 char
   SebutBilanganPuluh = "Ten Twenty Thirty Forty Fifty Sixty Seventy Eighty Ninety " '8 char

   If Angka < 0 Then
   TandaRincian = "Minus "
   ElseIf Angka = 0 Then
   TandaRincian = "Nul "
   Else
   TandaRincian = ""
   End If

   If Abs(Angka) >= 1000000000000# Then
   LAMU = "# TOO BIG JOOOOO! Call " & France & " for Help."
   Exit Function
   End If

   Angka = Abs(Angka)
   Sen = PECAHAN(Angka)

   If Sen <> 0 Then
   LAMU = "# FRACTION COI...! Call " & France & " for Help."
   Exit Function
   End If

   TextHubungan = " and "
   Hubungan = 0
   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 * 6 - 5, 6))
   End If

   Select Case DigitPuluhan
   Case Is = 0
   TerbilangPuluhan = TerbilangSatuan
   Case Is = 1 And DigitSatuan > 0
   TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))
   Case Else
   TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan
   End Select

   If DigitRatusan = 0 Then
   TerbilangRatusan = TerbilangPuluhan
   Else
   Select Case TerbilangPuluhan
   Case Is = ""
   TextHubungan = ""
   Case Else
   TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)
   Hubungan = 1
   End Select
   TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " Hundred " & TerbilangPuluhan
   End If
   Rincian = Trim(TerbilangRatusan)
   End If

   If Ribu > 0 Then
   TextRupiah = Right("000" & Str$(Ribu), 3)
   DigitSatuan = Val(Right(TextRupiah, 1))
   DigitPuluhan = Val(Mid(TextRupiah, 2, 1))
   DigitRatusan = Val(Left(TextRupiah, 1))

   If Hubungan = 1 Then
   TextHubungan = ""
   ElseIf Rincian <> "" Then
   TextHubungan = " and "
   Rincian = Trim(TextHubungan & Rincian)
   Hubungan = 1
   End If

   If DigitSatuan = 0 Then
   TerbilangSatuan = ""
   Else
   TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 6 - 5, 6))
   End If

   Select Case DigitPuluhan
   Case Is = 0
   TerbilangPuluhan = TerbilangSatuan
   Case Is = 1 And DigitSatuan > 0
   TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))
   Case Else
   TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan
   End Select

   If DigitRatusan = 0 Then
   TerbilangRatusan = TerbilangPuluhan
   Else
   Select Case TerbilangPuluhan
   Case Is = ""
   TextHubungan = ""
   Case Else
   TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)
   Hubungan = 1
   End Select
   TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " Hundred " & TerbilangPuluhan
   End If
   Rincian = Trim(TerbilangRatusan) & " thousand " & 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 Hubungan = 1 Then
   TextHubungan = ""
   ElseIf Rincian <> "" Then
   TextHubungan = " and "
   Rincian = Trim(TextHubungan & Rincian)
   Hubungan = 1
   End If

   If DigitSatuan = 0 Then
   TerbilangSatuan = ""
   Else
   TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 6 - 5, 6))
   End If

   Select Case DigitPuluhan
   Case Is = 0
   TerbilangPuluhan = TerbilangSatuan
   Case Is = 1 And DigitSatuan > 0
   TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))
   Case Else
   TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan
   End Select

   If DigitRatusan = 0 Then
   TerbilangRatusan = TerbilangPuluhan
   Else
   Select Case TerbilangPuluhan
   Case Is = ""
   TextHubungan = ""
   Case Else
   TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)
   Hubungan = 1
   End Select
   TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " Hundred " & TerbilangPuluhan
   End If
   Rincian = Trim(TerbilangRatusan) & " Million " & 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 Hubungan = 1 Then
   TextHubungan = ""
   ElseIf Rincian <> "" Then
   TextHubungan = " and "
   Rincian = Trim(TextHubungan & Rincian)
   Hubungan = 1
   End If

   If DigitSatuan = 0 Then
   TerbilangSatuan = ""
   Else
   TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 6 - 5, 6))
   End If

   Select Case DigitPuluhan
   Case Is = 0
   TerbilangPuluhan = TerbilangSatuan
   Case Is = 1 And DigitSatuan > 0
   TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))
   Case Else
   TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan
   End Select

   If DigitRatusan = 0 Then
   TerbilangRatusan = TerbilangPuluhan
   Else
   Select Case TerbilangPuluhan
   Case Is = ""
   TextHubungan = ""
   Case Else
   TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)
   Hubungan = 1
   End Select
   TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " Hundred " & TerbilangPuluhan
   End If
   Rincian = Trim(TerbilangRatusan) & " Milliard " & Rincian
   End If

   LAMU = TandaRincian & Trim(Rincian) & " " & Text_Satuan

End Function