Bagaimana
membuat membuat Add In terbilang (menterjemahkan angka menjadi
kata-kata ) pada Microsoft Excel 2007. Bagi anda yang sering membuat
tanda terima pembayaran tentunya sering kali anda harus menterjemahkan
angka-angka menjadi kata-kata, misal Rp. 1000,- diterjemahkan menjadi "Seribu Rupiah",
tentu akan sangat melelahkan jika hal ini harus dikerjakan secara
manual, dimana anda harus mengeja setiap angka pada transaksi anda untuk
kemudian anda ketik. Tujuan Add In ini saya berharap akan bisa membantu
mempermudah pekerjaan dalam membuat tanda terima dan mempersingkat
proses.
Langkah-langkahnya sebagai berikut :
1. Pilih tab View - Macros - View Macros
2. Muncul popup Macros lalu tulis nama macro pada kolom "Macro name" (tanpa spasi)
3. Lalu pilih "Create"
4. Maka muncul "Microsoft visual basic for applications"
5. Pada folder "Modules" klik kanan pada "New Macros - View Code" (delete semua perintah yang ada sebelumnya)
6. Copy paste perintah berikut ini :
Option Explicit
Sub ctvTerbilang()
Dim Number As Variant, Kata As String, sText As String
Const Ttel As String = “Terbilang Max 18 digit saja loh!”sText = Replace(Selection, Chr(10), “”)
Selection = sText
If IsNumeric(Selection) Then
Number = CDec(Selection)
With Selection
.Copy
.EndKey Unit:=wdLine
.TypeParagraph
End WithSelect Case Number
Case 0
Kata = “Zero”
Case 0.001 To 1E+18
Kata = TERBILANG(Number)
Case Else
MsgBox “Bilangan Terlalu besar!”, 48, Ttel
End Select
Else
MsgBox “Tidak ada bilangan di dalam selection!!”, 48, Ttel
End If
Selection = Kata
End SubPrivate Function TERBILANG(Nnum As Variant) As String
Dim nUtuh As Variant, nDesi As Variant
Dim sUtuh As String, sDesi As String
Nnum = CDec(Round(Nnum, 2))
nUtuh = CDec(Int(Nnum))
nDesi = CDec(Round((Nnum – nUtuh) * 100, 0))
sUtuh = TransX(nUtuh)
If nDesi = 0 Then
sDesi = “”
Else
sDesi = “dan ” & TransX(nDesi) & ” per seratus”
End If
TERBILANG = Trim(sUtuh & ” ” & sDesi)
End FunctionPrivate Function TransX(Bilangan As Variant) As String
Dim TxtBil As String, Teks As String, i As Integer, Pos As Integer
Dim Angka(19) As String, Puluh(9) As String, Letak(4) As String
Dim DwiDigit As Byte, TriD1 As Byte, TriD2 As Byte, TriD3 As Byte
Angka(1) = “satu”: Angka(2) = “dua”: Angka(3) = “tiga”
Angka(4) = “empat”: Angka(5) = “lima”: Angka(6) = “enam”
Angka(7) = “tujuh”: Angka(8) = “delapan”: Angka(9) = “sembilan”:
Angka(10) = “sepuluh”: Angka(11) = “sebelas”: Angka(12) = “dua belas”
Angka(13) = “tiga belas”: Angka(14) = “empat belas”: Angka(15) = “lima belas”
Angka(16) = “enam belas”: Angka(17) = “tujuh belas”: Angka(18) = “delapan belas”
Angka(19) = “sembilan belas”
Puluh(0) = “”: Puluh(2) = “dua puluh”: Puluh(3) = “tiga puluh”
Puluh(4) = “empat puluh”: Puluh(5) = “lima puluh”: Puluh(6) = “enam puluh”
Puluh(7) = “tujuh puluh”: Puluh(8) = “delapan puluh”: Puluh(9) = “sembilan puluh”
Letak(0) = “ribu”: Letak(1) = “juta”
Letak(2) = “milyar”: Letak(3) = “triliun”: Letak(4) = “kuadriliun”
Bilangan = CDec(Bilangan)
TxtBil = Trim(Str(Round(Abs(Bilangan), 0)))
If CDec(TxtBil) = 0 Then
Teks = “nol ”
Else
i = 0
Do
TxtBil = “000? + TxtBil
DwiDigit = CByte(Right(TxtBil, 2))
If (DwiDigit > 0) And (DwiDigit < 20) Then
Teks = IIf((Bilangan < 2000 And i = 1), “se”, Angka(DwiDigit) + ” “) +
Teks Else TriD3 = CByte(Right(TxtBil, 1)) If (TriD3 > 0) Then Teks =
Angka(TriD3) + ” ” + Teks
TriD2 = CByte(Left(Right(TxtBil, 2), 1))
If (TriD2 > 0) Then Teks = Puluh(TriD2) + ” ” + Teks
End If
TriD1 = CByte(Left(Right(TxtBil, 3), 1))
If (TriD1 = 1) Then Teks = “seratus ” + Teks
If (TriD1 > 1) Then Teks = Angka(TriD1) + ” ratus ” + Teks
TxtBil = Left(TxtBil, Len(TxtBil) – 3)
If (CDec(TxtBil) > 0) Then
Teks = IIf(CInt(Right(TxtBil, 3)) = 0, “”, Letak(i) + ” “) + Teks
i = i + 1
End If
Loop While ((CDec(TxtBil) > 0) And (i < 6))
End If
TransX = Trim(Teks)
End Function
7. Lalu pilih File - Save normal
8. Klik File - Close and Return to Microsoft Word
9. Pilih save as dengan type "Word Macro-Enabled Document"
10. Setelah itu coba jalankan microsoft word 2007
11.
Lalu coba macro dengan pilih tab View - Macros - View Macros. Nama
macro yan dibuat sebelumnya akan otomatis berubah menyesuaikan script
yang ada. Lalu coba anda tulis 123426353 dan seleksi angka tersebut lalu
pilih tab “View > Macros > View Macros > pilih nama macronya
lalu klik "Run"