Powered by Telkomsel BlackBerry®
-----Original Message-----
From: aksan kurdin <aksan.kurdin@gmail.com>
Sender: belajar-access@yahoogroups.com
Date: Wed, 12 Feb 2014 11:05:55
To: <belajar-access@yahoogroups.com>
Reply-To: belajar-access@yahoogroups.com
Subject: Re: [belajar-access] Tanya :Konversi huruf besar ke huruf kecil [4 Attachments]
bang safei,
saya bantu dengan logika nya ya, anda coba gabungkan dengan vba anda :
saya coba data mentah:
lalu saya buatkan query berikut untuk mendayagunakan fungsi vba StrConv:
besar semua menggunakan strconv(field1, 1)
kecil_semua menggunakan strconv(field1, 2)
besar_per_kata menggunakan strconv(field1, 3)
fungsi strconv hanya suply 3 jenis parameter tersebut.
untuk membentuk huruf besar cukup huruf depannya saja, banyak jalan
dengan vba, seperti cara rumit berikut:
atau dengan rumus singkat seperti berikut:
aksan kurdin
On 2/12/2014 8:53 AM, Muhamad Safei wrote:
> 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..
>
------------------------------------
SPAM IS PROHIBITEDYahoo Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/belajar-access/
<*> Your email settings:
Individual Email | Traditional
<*> To change settings online go to:
http://groups.yahoo.com/group/belajar-access/join
(Yahoo! ID required)
<*> To change settings via email:
belajar-access-digest@yahoogroups.com
belajar-access-fullfeatured@yahoogroups.com
<*> To unsubscribe from this group, send an email to:
belajar-access-unsubscribe@yahoogroups.com
<*> Your use of Yahoo Groups is subject to:
http://info.yahoo.com/legal/us/yahoo/utos/terms/
Tidak ada komentar:
Posting Komentar