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
Slamat siang
BalasHapusBisa bantu cara-cara masukkan data macro nya ?
Tks atas bantuannya
Abdi