Kali ini saya akan menjelaskan langkah demi langkah bagaimana cara membuat Convert Number to Text. Convert Numbers to Text bertujuan untuk merubah angka menjadi huruf terbilang seperti yang biasa terdapat dalam kwitansi. Convert Numbers to Text ini tersedia dalam bahasa Inggris dan bahasa Indonesia.
Kita mulai dengan membuat form terlebih dahulu dengan menekan
Alt + F8 (Microsoft Visual Basic) lalu
Insert > User Form.
Selanjutnya form kosong di atas didesain seperti gambar di bawah ini dengan menggunakan fungsi-fungsi yang ada dalam Toolbox:
Perhatikan nomor-nomor di atas. Nomor-nomor tersebut adalah untuk menjelaskan masing-masing properties, isi propertiesnya sbb:
1. Form2. Reference Cell3. Output Cell4. Tombol radio English5. Tombol radio Bahasa Indonesia6. Tombol Convert7. Tombol ExitUntuk scriptnya pilih
View > Code lalu gunakan script berikut:
1. FormPrivate Sub UserForm_Activate() opt_english.Value = True cmd_run.SetFocusEnd Sub
Private Sub UserForm_QueryClose _(cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then cancel = TrueEnd IfEnd Sub6. Tombol ConvertPrivate Sub cmd_run_Click() If Ref_cell.Value = "" Or Output_cell.Value = "" Then MsgBox "Reference cell and Output cell must not be empty.", vbCritical + vbOKOnly, "Enter Reference and Output Cell" Else If Ref_cell.Value = Output_cell.Value Then MsgBox "Reference cell and Output cell must not be the same. Please select other cell for Output Cell.", vbCritical + vbOKOnly, "Reference and Output Cell Error" Else If opt_english.Value = False Then Range(Output_cell.Value).Select ActiveCell.Value = "=dghrf(" & Ref_cell.Value & ")" Else Range(Output_cell.Value).Select ActiveCell.Value = "=txtString(" & Ref_cell.Value & ")" End If End If End IfEnd Sub7. Tombol ExitPrivate Sub cmd_cancel_Click() Unload MeEnd SubSelanjutnya pilih
ThisWorkbook pada window
Project – VBA Project dan gunakan script berikut pada window sebelah kanan:
Sub Open_Form_Convert2Text() With Form_Convert2Text .Show vbModeless End WithEnd SubSampai tahap di atas kita baru membuat tampilan interfacenya (GUI), sedang untuk mendefinisikan function
=dghrf dan
=txtString kita buat dengan 2 (dua) Modules. Pilih
Insert > Module dan beri nama
Angka2Text pada propertiesnya dan masukkan script di bawah ini:
Dim Huruf(0 To 9) As StringDim ax(0 To 3) As Double
Function INIT_angka() Huruf(0) = "" Huruf(1) = "satu " Huruf(2) = "dua " Huruf(3) = "tiga " Huruf(4) = "empat " Huruf(5) = "lima " Huruf(6) = "enam " Huruf(7) = "tujuh " Huruf(8) = "delapan " Huruf(9) = "sembilan "End Function
Function dgratus(angka As Double) As String Temp = "" INIT_angka panjang = Len(Trim(Str(angka))) nilai = Right("000", 3 - panjang) + Trim(Str(angka)) For y = 3 To 1 Step -1 ax(y) = Mid(nilai, y, 1) Next y Select Case ax(1) Case Is = 1 Temp = "seratus " Case Is > 1 Temp = Huruf(Val(ax(1))) + " " + "ratus " Case Else Temp = " " End Select Select Case ax(2) Case Is = 0 Temp = Temp + Huruf(Val(ax(3))) Case Is = 1 Select Case ax(3) Case Is = 1 Temp = Temp + "sebelas " Case Is = 0 Temp = Temp + "sepuluh " Case Else Temp = Temp + Huruf(Val(ax(3))) + "belas " End Select Case Is > 1 Temp = Temp + Huruf(Val(ax(2))) + "puluh " Temp = Temp + " " + Huruf(Val(ax(3))) End Select dgratus = TempEnd Function
Function dghrf(angka As Double) As String Dim ratusan(0 To 6) As String Dim sebut(0 To 4) As String sebut(1) = " ribu " sebut(2) = " juta " sebut(3) = " milyar " sebut(4) = " trilyun " panjang = Len(Trim(Str(angka))) kali = Int(panjang / 3) If Int(panjang / 3) * 3 <> panjang Then kali = kali + 1 sisa = panjang - Int(panjang / 3) * 3 nilai = Right("000", 3 - sisa) + Trim(Str(angka)) Else nilai = Trim(Str(angka)) End If For x = 0 To kali ratusan(kali - x) = Mid(nilai, x * 3 + 1, 3) Next x For y = kali To 1 Step -1 If y = 2 And Val(ratusan(y)) = 1 Then Temp = Temp + "seribu" Else If Val(ratusan(y)) = 0 Then Temp = Temp Else Temp = Temp + dgratus(Val(ratusan(y))) Temp = Temp + sebut(y - 1) End If End If Next y dghrf = Application.Trim(Application.Proper(Temp)) + " Rupiah"End Function
Selanjutnya pilih lagi
Insert > Module dan beri nama
Convert2Text pada propertiesnya. Masukkan script di bawah ini:
Public Function txtString(jumlah As Long)jumlah = Application.Round(jumlah, 2)If Application.IsNumber(jumlah) = True ThenDim MyNum, Num1, NumLength, txStringDim Million, Thousand, Hundred, myDecimalDim MyDollar, MyCentDim Space, SeparatorDim Digit1, Digit2, Digit3, Digit4, Digit5Dim Digit6, Digit7, Digit8, Digit9Dim Digit11, Digit12 'DecimalsDim txRM Dim Rng, i Rng = Selection.Rows.Count For i = 1 To RngMyDollar = "IDR " 'Must be within theMyCent = "Sen " 'For Next Loop'--------------------------------------------------Digit1 = 0 'Resets numbersDigit2 = 0Digit3 = 0Digit4 = 0Digit5 = 0Digit6 = 0Digit7 = 0Digit8 = 0Digit9 = 0Digit11 = 0Digit12 = 0Million = ""Thousand = ""Hundred = ""myDecimal = ""'--------------------------------------------------Num1 = jumlahMyNum = Format(Num1, "#0.00") 'Shows 2 decimal placesNumLength = Len(MyNum) 'Determines the length of the numberSelect Case NumLength 'Length determines theCase 12 'position of the text boxesDigit1 = Mid(MyNum, 1, 1)Digit2 = Mid(MyNum, 2, 1)Digit3 = Mid(MyNum, 3, 1)Digit4 = Mid(MyNum, 4, 1)Digit5 = Mid(MyNum, 5, 1)Digit6 = Mid(MyNum, 6, 1)Digit7 = Mid(MyNum, 7, 1)Digit8 = Mid(MyNum, 8, 1)Digit9 = Mid(MyNum, 9, 1)Digit11 = Mid(MyNum, 11, 1)Digit12 = Mid(MyNum, 12, 1)Case 11Digit2 = Mid(MyNum, 1, 1)Digit3 = Mid(MyNum, 2, 1)Digit4 = Mid(MyNum, 3, 1)Digit5 = Mid(MyNum, 4, 1)Digit6 = Mid(MyNum, 5, 1)Digit7 = Mid(MyNum, 6, 1)Digit8 = Mid(MyNum, 7, 1)Digit9 = Mid(MyNum, 8, 1)Digit11 = Mid(MyNum, 10, 1)Digit12 = Mid(MyNum, 11, 1)Case 10Digit3 = Mid(MyNum, 1, 1)Digit4 = Mid(MyNum, 2, 1)Digit5 = Mid(MyNum, 3, 1)Digit6 = Mid(MyNum, 4, 1)Digit7 = Mid(MyNum, 5, 1)Digit8 = Mid(MyNum, 6, 1)Digit9 = Mid(MyNum, 7, 1)Digit11 = Mid(MyNum, 9, 1)Digit12 = Mid(MyNum, 10, 1)Case 9Digit4 = Mid(MyNum, 1, 1)Digit5 = Mid(MyNum, 2, 1)Digit6 = Mid(MyNum, 3, 1)Digit7 = Mid(MyNum, 4, 1)Digit8 = Mid(MyNum, 5, 1)Digit9 = Mid(MyNum, 6, 1)Digit11 = Mid(MyNum, 8, 1)Digit12 = Mid(MyNum, 9, 1)Case 8Digit5 = Mid(MyNum, 1, 1)Digit6 = Mid(MyNum, 2, 1)Digit7 = Mid(MyNum, 3, 1)Digit8 = Mid(MyNum, 4, 1)Digit9 = Mid(MyNum, 5, 1)Digit11 = Mid(MyNum, 7, 1)Digit12 = Mid(MyNum, 8, 1)Case 7Digit6 = Mid(MyNum, 1, 1)Digit7 = Mid(MyNum, 2, 1)Digit8 = Mid(MyNum, 3, 1)Digit9 = Mid(MyNum, 4, 1)Digit11 = Mid(MyNum, 6, 1)Digit12 = Mid(MyNum, 7, 1)Case 6Digit7 = Mid(MyNum, 1, 1)Digit8 = Mid(MyNum, 2, 1)Digit9 = Mid(MyNum, 3, 1)Digit11 = Mid(MyNum, 5, 1)Digit12 = Mid(MyNum, 6, 1)Case 5Digit8 = Mid(MyNum, 1, 1)Digit9 = Mid(MyNum, 2, 1)Digit11 = Mid(MyNum, 4, 1)Digit12 = Mid(MyNum, 5, 1)Case 4Digit9 = Mid(MyNum, 1, 1)Digit11 = Mid(MyNum, 3, 1)Digit12 = Mid(MyNum, 4, 1)Case 3Digit11 = Mid(MyNum, 2, 1)Digit12 = Mid(MyNum, 3, 1)Case 2Digit12 = Mid(MyNum, 2, 1)End Select'--------------------------------------------------'''Do millionIf Digit1 <> 0 Or Digit2 <> 0 Or Digit3 <> 0 ThenMillion = "Million "End IfDim M1M1 = Digit1Select Case M1Case 0M1 = ""Case 1M1 = "One Hundred "Case 2M1 = "Two Hundred "Case 3M1 = "Three Hundred "Case 4M1 = "Four Hundred "Case 5M1 = "Five Hundred "Case 6M1 = "Six Hundred "Case 7M1 = "Seven Hundred "Case 8M1 = "Eight Hundred "Case 9M1 = "Nine Hundred "End Select
Dim M2M2 = Digit2Select Case M2Case 0M2 = ""Case 1M2 = ""Case 2M2 = "Twenty "Case 3M2 = "Thirty "Case 4M2 = "Forty "Case 5M2 = "Fifty "Case 6M2 = "Sixty "Case 7M2 = "Seventy "Case 8M2 = "Eighty "Case 9M2 = "Ninety "End Select
Dim M3M3 = Digit3If Digit2 = 1 Then 'check against the number beforeSelect Case M3Case 0M3 = "Ten "Case 1M3 = "Eleven "Case 2M3 = "Twelve "Case 3M3 = "Thirteen "Case 4M3 = "Fourteen "Case 5M3 = "Fifteen "Case 6M3 = "Sixteen "Case 7M3 = "Seventeen "Case 8M3 = "Eighteen "Case 9M3 = "Nineteen "End SelectElseSelect Case M3Case 0M3 = ""Case 1M3 = "One "Case 2M3 = "Two "Case 3M3 = "Three "Case 4M3 = "Four "Case 5M3 = "Five "Case 6M3 = "Six "Case 7M3 = "Seven "Case 8M3 = "Eight "Case 9M3 = "Nine "End SelectEnd IfMillion = M1 & M2 & M3 & Million'----------------------------------------------------'''Do thousandIf Digit4 <> 0 Or Digit5 <> 0 Or Digit6 <> 0 ThenThousand = "Thousand "End IfDim T1T1 = Digit4Select Case T1Case 0T1 = ""Case 1T1 = "One Hundred "Case 2T1 = "Two Hundred "Case 3T1 = "Three Hundred "Case 4T1 = "Four Hundred "Case 5T1 = "Five Hundred "Case 6T1 = "Six Hundred "Case 7T1 = "Seven Hundred "Case 8T1 = "Eight Hundred "Case 9T1 = "Nine Hundred "End Select
Dim T2T2 = Digit5Select Case T2Case 0T2 = ""Case 1T2 = ""Case 2T2 = "Twenty "Case 3T2 = "Thirty "Case 4T2 = "Forty "Case 5T2 = "Fifty "Case 6T2 = "Sixty "Case 7T2 = "Seventy "Case 8T2 = "Eighty "Case 9T2 = "Ninety "End Select
Dim T3T3 = Digit6If Digit5 = 1 Then 'check against the number beforeSelect Case T3Case 0T3 = "Ten "Case 1T3 = "Eleven "Case 2T3 = "Twelve "Case 3T3 = "Thirteen "Case 4T3 = "Fourteen "Case 5T3 = "Fifteen "Case 6T3 = "Sixteen "Case 7T3 = "Seventeen "Case 8T3 = "Eighteen "Case 9T3 = "Nineteen "End SelectElseSelect Case T3Case 0T3 = ""Case 1T3 = "One "Case 2T3 = "Two "Case 3T3 = "Three "Case 4T3 = "Four "Case 5T3 = "Five "Case 6T3 = "Six "Case 7T3 = "Seven "Case 8T3 = "Eight "Case 9T3 = "Nine "End SelectEnd IfThousand = T1 & T2 & T3 & Thousand'----------------------------------------------------'''Do hundredIf Digit6 <> 0 Or Digit7 <> 0 Or Digit8 <> 0 ThenHundred = "Hundred "End IfDim H1H1 = Digit7Select Case H1Case 0H1 = ""Case 1H1 = "One Hundred "Case 2H1 = "Two Hundred "Case 3H1 = "Three Hundred "Case 4H1 = "Four Hundred "Case 5H1 = "Five Hundred "Case 6H1 = "Six Hundred "Case 7H1 = "Seven Hundred "Case 8H1 = "Eight Hundred "Case 9H1 = "Nine Hundred "End Select
Dim H2H2 = Digit8Select Case H2Case 0H2 = ""Case 1H2 = ""Case 2H2 = "Twenty "Case 3H2 = "Thirty "Case 4H2 = "Forty "Case 5H2 = "Fifty "Case 6H2 = "Sixty "Case 7H2 = "Seventy "Case 8H2 = "Eighty "Case 9H2 = "Ninety "End Select
Dim H3H3 = Digit9If Digit8 = 1 Then 'check against the number beforeSelect Case H3Case 0H3 = "Ten "Case 1H3 = "Eleven "Case 2H3 = "Twelve "Case 3H3 = "Thirteen "Case 4H3 = "Fourteen "Case 5H3 = "Fifteen "Case 6H3 = "Sixteen "Case 7H3 = "Seventeen "Case 8H3 = "Eighteen "Case 9H3 = "Nineteen "End SelectElseSelect Case H3Case 0H3 = ""Case 1H3 = "One "Case 2H3 = "Two "Case 3H3 = "Three "Case 4H3 = "Four "Case 5H3 = "Five "Case 6H3 = "Six "Case 7H3 = "Seven "Case 8H3 = "Eight "Case 9H3 = "Nine "End SelectEnd If
Hundred = H1 & H2 & H3'----------------------------------------------------'Do decimalDim D1D1 = Digit11Select Case D1Case 0D1 = ""Case 1D1 = ""Case 2D1 = "Twenty "Case 3D1 = "Thirty "Case 4D1 = "Forty "Case 5D1 = "Fifty "Case 6D1 = "Sixty "Case 7D1 = "Seventy "Case 8D1 = "Eighty "Case 9D1 = "Ninety "End Select
Dim D2D2 = Digit12If Digit11 = 1 Then 'check against the number beforeSelect Case D2Case 0D2 = "Ten "Case 1D2 = "Eleven "Case 2D2 = "Twelve "Case 3D2 = "Thirteen "Case 4D2 = "Fourteen "Case 5D2 = "Fifteen "Case 6D2 = "Sixteen "Case 7D2 = "Seventeen "Case 8D2 = "Eighteen "Case 9D2 = "Nineteen "End SelectElseSelect Case D2Case 0D2 = ""Case 1D2 = "One "Case 2D2 = "Two "Case 3D2 = "Three "Case 4D2 = "Four "Case 5D2 = "Five "Case 6D2 = "Six "Case 7D2 = "Seven "Case 8D2 = "Eight "Case 9D2 = "Nine "End SelectEnd IfmyDecimal = D1 & D2'--------------------------------------------------'--------------------------------------------------If Million = "" And Thousand = "" And Hundred = "" Then MyDollar = "" Space = "" Separator = "" Else: Space = " " Separator = "And "End IfIf myDecimal = "" Then MyCent = "" Separator = ""End IfIf txRM = "" Then Space = "" 'So that the 1st digit will not have a gap in frontEnd IftxtString = MyDollar & Space & Million & Thousand & Hundred & Separator & MyCent & myDecimal'ActiveCell = txtString'ActiveCell.Offset(1, 0).SelectNext iExit FunctionElseMsgBox "The cell must contain a number", vbCritical, "Macro Error"End IfEnd Function
Untuk menjalankan macro ini silahkan balik ke window Microsoft Excel lalu tekan
Alt + F8 lalu pilih
Open_Form_Convert2Text dan klik
Run.
Untuk lebih lengkap mengenai penggunaan macro ini, silahkan buka artikel
Convert Numbers to Text.
Selamat mencoba!
Read More