Rabu, 08 September 2010

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

1 komentar:

  1. Slamat siang
    Bisa bantu cara-cara masukkan data macro nya ?

    Tks atas bantuannya

    Abdi

    BalasHapus