Wednesday, 28 March 2012

Merubah Angka Menjadi Huruf Pada MS. Excell

Ketika menggunakan M.S Excel, beberapa dari kita pasti mengalami masalah ketika harus mengetikkan terbilang dari sebuah angka menjadi huruf, masalahnya akan terjadi ketika angka dirubah dan harus mengetik kembali huruf terbilangnya demikian seterusnya.
Kali ini saya akan memberikan pencerahan bagaimana caranya agar ketika angka dirubah huruf yang adapun ikut berubah mengikuti perubahan pada angka yang diketikkan.
Sebenarnya pada M.S Excel sudah ada program merubah angka menjadi huruf namun belum ada untuk merubah ke bahasa Indonesia. Untuk itu kita harus membuat sebuah program melalui Macro kemudian di aplikasikan ke M.S Excel melalui add ins.
 Berikut langkah-langkahnya :
  1. Buka applikasi visual basic pada excel (excel option/popular/centang show developer tab in the ribbon).
  2. Kembali pada layar excel lalu pilih tab developer lalu click visual basic, kemudian pada layar visual basic click insert lalu pilih class module.
  3. Kemudian pada layar class module copy paste aja listing program berikut lalu di simpan dengan apa saja misal macro1 
    Option Explicit
    '***************
    ' Mengubah Angka Menjadi Teks
    '***************
    Function andy(ByVal mynumber)
        Dim Rupiah, Sen, Temp
        Dim Des, Desimal, Count, Tmp
        Dim IsNeg
        ReDim Place(9) As String
        Place(2) = "Ribu "
        Place(3) = "Juta "
        Place(4) = "Milyar "
        Place(5) = "Trilyun "
        'Ubah angka menjadi string
        mynumber = Round(mynumber, 2)
        mynumber = Trim(Str(mynumber))
        'Cek bilangan negatif
        If Mid(mynumber, 1, 1) = "-" Then
            mynumber = Right(mynumber, Len(mynumber) - 1)
            IsNeg = True
        End If
        'Posisi desimal, 0 jika bil. bulat
        Desimal = InStr(mynumber, ".")
        'Pembulatan sen, dua angka di belakang koma
        Des = Mid(mynumber, Desimal + 2)
        If Desimal > 0 Then
            Tmp = Left(Mid(mynumber, Desimal + 1) & "00", 2)
            If Left(Tmp, 1) = "0" Then
                Tmp = Mid(Tmp, 2)
                Sen = Satuan(Tmp)
            Else
                Sen = Puluhan(Tmp)
            End If
            mynumber = Trim(Left(mynumber, Desimal - 1))
        End If
        Count = 1
        Do While mynumber <> ""
           Temp = Ratusan(Right(mynumber, 3), Count)
           If Temp <> "" Then Rupiah = Temp & Place(Count) & Rupiah
              If Len(mynumber) > 3 Then
                 mynumber = Left(mynumber, Len(mynumber) - 3)
           Else
              mynumber = ""
           End If
           Count = Count + 1
        Loop
        Select Case Rupiah
            Case ""
                Rupiah = "nol rupiah."
            Case Else
                Rupiah = Rupiah & "Rupiah."
        End Select
        Select Case Sen
            Case ""
                Sen = ""
            Case Else
                Sen = " dan " & Sen & "sen"
        End Select
        If IsNeg = True Then
            andy = "minus " & Rupiah & Sen
        Else
            andy = Rupiah & Sen
        End If
    End Function
    '**************************************
    ' Mengubah angka 100-999 menjadi teks *
    '**************************************
    Function Ratusan(ByVal mynumber, Count)
        Dim Result As String
        Dim Tmp
        If Val(mynumber) = 0 Then Exit Function
        mynumber = Right("000" & mynumber, 3)
        'Mengubah seribu
        If mynumber = "001" And Count = 2 Then
            Ratusan = "Se"
            Exit Function
        End If
        'Mengubah ratusan
        If Mid(mynumber, 1, 1) <> "0" Then
            If Mid(mynumber, 1, 1) = "1" Then
                Result = "Seratus "
            Else
                Result = Satuan(Mid(mynumber, 1, 1)) & "Ratus "
            End If
        End If
        'Mengubah puluhan dan satuan
        If Mid(mynumber, 2, 1) <> "0" Then
            Result = Result & Puluhan(Mid(mynumber, 2))
        Else
            Result = Result & Satuan(Mid(mynumber, 3))
        End If
         Ratusan = Result
    End Function
    '*******************
    ' Mengubah puluhan *
    '*******************
    Function Puluhan(TeksPuluhan)
        Dim Result As String
        Result = ""
        ' nilai antara 10-19
        If Val(Left(TeksPuluhan, 1)) = 1 Then
            Select Case Val(TeksPuluhan)
                Case 10: Result = "Sepuluh "
                Case 11: Result = "Sebelas "
                Case Else
                    Result = Satuan(Mid(TeksPuluhan, 2)) & "Belas "
            End Select
        ' nilai antara 20-99
        Else
            Result = Satuan(Mid(TeksPuluhan, 1, 1)) _
                     & "puluh "
            Result = Result & Satuan(Right(TeksPuluhan, 1))
       'satuan
        End If
            Puluhan = Result
        End Function
    '********************************
    ' Mengubah satuan menjadi teks. *
    '********************************
    Function Satuan(Digit)
        Select Case Val(Digit)
            Case 1: Satuan = "Satu "
            Case 2: Satuan = "Dua "
            Case 3: Satuan = "Tiga "
            Case 4: Satuan = "Empat "
            Case 5: Satuan = "Lima "
            Case 6: Satuan = "Enam "
            Case 7: Satuan = "Tujuh "
            Case 8: Satuan = "Delapan "
            Case 9: Satuan = "Sembilan "
            Case Else: Satuan = ""
        End Select
    End Function 
  4. Setelah listing program disimpan lalu kita panggil memalui add ins caranya kembali buka excel option click tab add ins click go lalu pergi ke browse... dan cari file macro1 yang disimpan tadi
  5. Cara menggunakannya tinggal di buka excel terus ketikkan sebuah angka kemudian pada sell yang lain ketikkan  =andy(sell yang berisi angka)
  6. Selesai dan selamat menikmati dan selamat bereksperimen    
Jika anda tertarik menjadi teknisi komputer dan sekaligus menjadi pengusaha refill tinta printer..tidak perlu kursus..! hanya paket buku ini yang anda perlukan. Ebook ini lengkap menjelaskan tentang panduan perbaikan komputer, dan cara refill tinta cartridge serta perlengkapan yang dibutuhkan untuk usaha refill tinta printer di sini   «« masuk aja.

No comments:

Post a Comment