ACCESS FEED: [belajar-access] Tanya :Konversi huruf besar ke huruf kecil

Selasa, 11 Februari 2014

[belajar-access] Tanya :Konversi huruf besar ke huruf kecil

Selamat pagi semuanya...mohon bimbingannya..saya sedang membuat aplikasi sederhana untuk chek..

saya sudah membuat fungsi untuk konversi Satuan Angka ke Bilangan/Huruf..

Permasalahannya,setiap hasil konversi bilangannya huruf depan dari setiap suku katanya Menjadi huruf besar.saya agak kebingunan gimana caranya supaya hasil konversinya huruf besarnya hanya diAwal suku kata pertama saja...

contoh : Rp.2.750.000

hasil Konv : Dua juta tujuh ratus lima puluh ribu rupiah...

hsl yg sekarang : Dua Juta Tujuh Ratus Lima Puluh Ribu Rupiah..

Berikut Fungsinya..mohon koreksinya ...

---------------------------------------------------------------------------------------------

Function KonversiCurrencyKeRupiah(ByVal MyNumber, lRupiah As Boolean)

Dim Temp
Dim Rupiah, sent
Dim PosisiDesimal, Count

    ReDim posisi(9) As String
    posisi(2) = " Ribu "
    posisi(3) = " Juta "
    posisi(4) = " Miliar "
    posisi(5) = " Triliun "

    ' Konversi MyNumber ke string, trimming extra spaces.
   ' MyNumber = Trim(Str(MyNumber))

    ' Find Posisi desimal.
    PosisiDesimal = InStr(MyNumber, ".")

    ' Jika ketemu Posisi desimal...
    If PosisiDesimal > 0 Then
        ' Konversi Sent
        Temp = Left(Mid(MyNumber, PosisiDesimal + 1) & "00", 2)
        sent = KonversiTens(Temp)

        ' Strip off Sent dari remainder ke Konversi.
        MyNumber = Trim(Left(MyNumber, PosisiDesimal - 1))
    End If

    ' Untuk awalan Seribu
    If (MyNumber < 2000) And (MyNumber > 999) Then
        Temp = KonversiHundreds(Right(MyNumber, 3))
        Rupiah = "Seribu " & Temp & Rupiah
    Else
        Count = 1
        Do While MyNumber <> ""
            ' Konversi 3 digit terakhir MyNumber ke Rupiah.
            Temp = KonversiHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Rupiah = Temp & posisi(Count) & Rupiah
            If Len(MyNumber) > 3 Then
                ' Buang 3 hasil Konversi digit terakhir dari MyNumber.
                MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
                MyNumber = ""
            End If
            Count = Count + 1
        Loop
    End If
    ' Bersihkan Rupiah Rupiah.
    Select Case Rupiah
        Case ""
            Rupiah = ""
        Case "Sent"
            If lRupiah Then
               Rupiah = "Satu Rupiah"
            Else
               Rupiah = "Satu Dollar"
            End If
        Case Else
            If lRupiah Then
               Rupiah = Rupiah & " Rupiah"
            Else
               Rupiah = Rupiah & " Dollar"
            End If
    End Select

    ' Bersihkan Sent.
    Select Case sent
        Case ""
            sent = ""
        Case "One"
            sent = " Satu Sen"
        Case Else
            sent = " " & sent & " Sen"
    End Select

    KonversiCurrencyKeRupiah = Rupiah & sent

End Function

Private Function KonversiDigit(ByVal MyDigit)
    Select Case Val(MyDigit)
        Case 1: KonversiDigit = "Satu"
        Case 2: KonversiDigit = "Dua"
        Case 3: KonversiDigit = "Tiga"
        Case 4: KonversiDigit = "Empat"
        Case 5: KonversiDigit = "Lima"
        Case 6: KonversiDigit = "Enam"
        Case 7: KonversiDigit = "Tujuh"
        Case 8: KonversiDigit = "Delapan"
        Case 9: KonversiDigit = "Sembilan"
        Case Else: KonversiDigit = ""
    End Select
End Function

Private Function KonversiHundreds(ByVal MyNumber)
Dim Result As String

    ' Jika tidak ada yang akan dikonversi Konversi.
    If Val(MyNumber) = 0 Then Exit Function

    ' Tambahkan nol pada angka.
    MyNumber = Right("000" & MyNumber, 3)

    ' Apakah kita punya posisi digit ratusan untuk di Konversi?
    If Left(MyNumber, 1) <> "0" Then
        Result = KonversiDigit(Left(MyNumber, 1)) & " Ratus "
    End If

    ' Untuk awalan SEratus
    If Left(MyNumber, 1) = "1" Then
        Result = " Seratus "
    End If

    ' Apakah kita punya Posisi digit Tens untuk di Konversi?
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & KonversiTens(Mid(MyNumber, 2))
    Else
        ' Jika tidak, Konversi the Satu Posisi digit.
        Result = Result & KonversiDigit(Mid(MyNumber, 3))
    End If

    KonversiHundreds = Trim(Result)

End Function

Private Function KonversiTens(ByVal MyTens)
Dim Result As String

    ' Apakah nilai antara 10 dan 19?
    If Val(Left(MyTens, 1)) = 1 Then
        Select Case Val(MyTens)
            Case 10: Result = "Sepuluh"
            Case 11: Result = "Sebelas"
            Case 12: Result = "Dua Belas"
            Case 13: Result = "Tiga Belas"
            Case 14: Result = "Empat Belas"
            Case 15: Result = "Lima Belas"
            Case 16: Result = "Enam Belas"
            Case 17: Result = "Tujuh Belas"
            Case 18: Result = "Delapan Belas"
            Case 19: Result = "Sembilan Belas"
            Case Else
        End Select
    Else
        ' .. selainnya, antara 20 dan 99.
        Select Case Val(Left(MyTens, 1))
            Case 2: Result = "Dua Puluh "
            Case 3: Result = "Tiga Puluh "
            Case 4: Result = "Empat Puluh "
            Case 5: Result = "Lima Puluh "
            Case 6: Result = "Enam Puluh "
            Case 7: Result = "Tujuh Puluh "
            Case 8: Result = "Delapan Puluh "
            Case 9: Result = "Sembilan Puluh "
            Case Else
        End Select

        ' Konversi Posisi digit Satu.
        Result = Result & KonversiDigit(Right(MyTens, 1))
    End If

    KonversiTens = Result

End Function
------------------------------------------------------------------------------------------

Trimakasih sebelumnya..

__._,_.___

Reply via web post

Reply to sender

Reply to group

Start a New Topic

Messages in this topic (1)

SPAM IS PROHIBITED

Visit Your Group