Tag Archives: VB Application

Access: Angka Terbilang

23 Monday Jun 2003

Posted by in Pemrogramman

≈ Leave a Comment

Tags

, ,

Contoh kode dibawah ini hampir mirip dengan contoh program di VB yang juga sudah diupload  di blog ini. Kode program dibawah ini sudah disesuaikan dengan bahasa VBA di Access, sehingga Anda yang ingin memanfaatkan untuk mengkonversi angka kedalam teks (terbilang) tinggal copy-paste saja.

Function AngkaToTeks(lnAngka) As String
Dim lcOldAngka As String
Dim lcAngka As String
Dim lcAmt As String
Dim lcTeks As String
Dim i As Integer
    i = 0
    lcAmt = ""
    lcTeks = "Satu    Dua     Tiga    Empat   Lima    Enam    Tujuh   Delapan Sembilan"

    lcOldAngka = Trim(Str(Round(lnAngka, 0)))

    ' Angka 12 menandakan panjang maksimal 12 digit.
    lcOldAngka = Space(12 - Len(lcOldAngka)) & lcOldAngka

    ' 3 berarti looping sebanyak 4 kali, karena AngkaToTeks ini sampai
    '   miliar-an.
    '   contoh: 123.456.789.012
    '           0   1   2   3

    For i = 0 To 3

        lcAngka = Mid(lcOldAngka, i * 3 + 1, 3)
        If Not (Trim(lcAngka) = "") And Val(lcAngka) > 0 Then
            If Mid(lcAngka, 1, 1) = "1" Then
                lcAmt = lcAmt + " Seratus "
            End If

            If Mid(lcAngka, 1, 1) > "1" Then
                 lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 1, 1)) * 8 - 7, 8)) + " Ratus "
            End If

            If Mid(lcAngka, 2, 1) = "1" Then
                 Select Case Mid(lcAngka, 3, 1)
                    Case "0"
                         lcAmt = lcAmt + " Sepuluh "
                    Case "1"
                         lcAmt = lcAmt + " Sebelas "
                    Case Is > "1"
                         lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8)) + " Belas "
                 End Select
            End If

            If Mid(lcAngka, 2, 1) > "1" Then
                 lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 2, 1)) * 8 - 7, 8)) + " Puluh "
                If Mid(lcAngka, 3, 1) > "0" Then
                     lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8))
                End If
            End If

            If Mid(lcAngka, 2, 1) = "0" And Mid(lcAngka, 3, 1) > "0" Then
                 lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8))
            End If

            If Mid(lcAngka, 1, 2) = "  " And Mid(lcAngka, 3, 1) > "0" Then
                 lcAmt = lcAmt + RTrim(Mid(lcTeks, Val(Mid(lcAngka, 3, 1)) * 8 - 7, 8))
            End If
            If i = 0 Then
                lcAmt = lcAmt + " Miliar "
            End If
            If i = 1 Then
                lcAmt = lcAmt + " Juta "
            End If
            If i = 2 Then
                lcAmt = lcAmt + " Ribu "
            End If
        End If

    Next

    If Not lcAmt = "" Then
        AngkaToTeks = lcAmt + " Rupiah"
    Else
        AngkaToTeks = "Nol Rupiah"
    End If

End Function
Continue reading »

VBA: Angka Terbilang

21 Friday Mar 2003

Posted by in Microsoft Office, Pemrogramman

≈ 1 Comment

Tags

,

Konversi Angka ke Teks (Terbilang) menggunakan Macro Excel. Contoh ini terbatas sampai milliar, untuk meningkatkan ke trilliun, billiun dst, Anda tinggal merubah Looping dan kondisi IF seperti contoh untuk juta dan milliar.

Berikut ini adalah kode untuk Angka Terbilang:

Function AngkaToTeks(lnAngka) As String
Dim lcOldAngka As String
Dim lcAngka As String
Dim lcAmt As String
Dim lcTeks As String
Dim i As Integer
    i = 0
    lcAmt = ""
    lcTeks = "Satu    Dua     Tiga    Empat   Lima    Enam    Tujuh   Delapan Sembilan"

    lcOldAngka = Trim(Str(Round(lnAngka, 0)))

    ' Angka 12 menandakan panjang maksimal 12 digit.
    lcOldAngka = Space(12 - Len(lcOldAngka)) & lcOldAngka

    ' 3 berarti looping sebanyak 4 kali, karena AngkaToTeks ini sampai
    '   miliar-an.
    '   contoh: 123.456.789.012
    '           0   1   2   3
 Continue reading »