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. Form
2. Reference Cell
3. Output Cell
4. Tombol radio English
5. Tombol radio Bahasa Indonesia
6. Tombol Convert
7. Tombol Exit
Untuk scriptnya pilih View > Code lalu gunakan script berikut:
1. Form
Private Sub UserForm_Activate()
opt_english.Value = True
cmd_run.SetFocus
End Sub
Private Sub UserForm_QueryClose _
(cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
cancel = True
End If
End Sub
6. Tombol Convert
Private 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 If
End Sub
7. Tombol Exit
Private Sub cmd_cancel_Click()
Unload Me
End Sub
Selanjutnya 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 With
End Sub
Sampai 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 String
Dim 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 = Temp
End 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 Then
Dim MyNum, Num1, NumLength, txString
Dim Million, Thousand, Hundred, myDecimal
Dim MyDollar, MyCent
Dim Space, Separator
Dim Digit1, Digit2, Digit3, Digit4, Digit5
Dim Digit6, Digit7, Digit8, Digit9
Dim Digit11, Digit12 'Decimals
Dim txRM
Dim Rng, i
Rng = Selection.Rows.Count
For i = 1 To Rng
MyDollar = "IDR " 'Must be within the
MyCent = "Sen " 'For Next Loop
'--------------------------------------------------
Digit1 = 0 'Resets numbers
Digit2 = 0
Digit3 = 0
Digit4 = 0
Digit5 = 0
Digit6 = 0
Digit7 = 0
Digit8 = 0
Digit9 = 0
Digit11 = 0
Digit12 = 0
Million = ""
Thousand = ""
Hundred = ""
myDecimal = ""
'--------------------------------------------------
Num1 = jumlah
MyNum = Format(Num1, "#0.00") 'Shows 2 decimal places
NumLength = Len(MyNum) 'Determines the length of the number
Select Case NumLength 'Length determines the
Case 12 'position of the text boxes
Digit1 = 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 11
Digit2 = 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 10
Digit3 = 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 9
Digit4 = 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 8
Digit5 = 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 7
Digit6 = 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 6
Digit7 = 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 5
Digit8 = Mid(MyNum, 1, 1)
Digit9 = Mid(MyNum, 2, 1)
Digit11 = Mid(MyNum, 4, 1)
Digit12 = Mid(MyNum, 5, 1)
Case 4
Digit9 = Mid(MyNum, 1, 1)
Digit11 = Mid(MyNum, 3, 1)
Digit12 = Mid(MyNum, 4, 1)
Case 3
Digit11 = Mid(MyNum, 2, 1)
Digit12 = Mid(MyNum, 3, 1)
Case 2
Digit12 = Mid(MyNum, 2, 1)
End Select
'--------------------------------------------------
'''Do million
If Digit1 <> 0 Or Digit2 <> 0 Or Digit3 <> 0 Then
Million = "Million "
End If
Dim M1
M1 = Digit1
Select Case M1
Case 0
M1 = ""
Case 1
M1 = "One Hundred "
Case 2
M1 = "Two Hundred "
Case 3
M1 = "Three Hundred "
Case 4
M1 = "Four Hundred "
Case 5
M1 = "Five Hundred "
Case 6
M1 = "Six Hundred "
Case 7
M1 = "Seven Hundred "
Case 8
M1 = "Eight Hundred "
Case 9
M1 = "Nine Hundred "
End Select
Dim M2
M2 = Digit2
Select Case M2
Case 0
M2 = ""
Case 1
M2 = ""
Case 2
M2 = "Twenty "
Case 3
M2 = "Thirty "
Case 4
M2 = "Forty "
Case 5
M2 = "Fifty "
Case 6
M2 = "Sixty "
Case 7
M2 = "Seventy "
Case 8
M2 = "Eighty "
Case 9
M2 = "Ninety "
End Select
Dim M3
M3 = Digit3
If Digit2 = 1 Then 'check against the number before
Select Case M3
Case 0
M3 = "Ten "
Case 1
M3 = "Eleven "
Case 2
M3 = "Twelve "
Case 3
M3 = "Thirteen "
Case 4
M3 = "Fourteen "
Case 5
M3 = "Fifteen "
Case 6
M3 = "Sixteen "
Case 7
M3 = "Seventeen "
Case 8
M3 = "Eighteen "
Case 9
M3 = "Nineteen "
End Select
Else
Select Case M3
Case 0
M3 = ""
Case 1
M3 = "One "
Case 2
M3 = "Two "
Case 3
M3 = "Three "
Case 4
M3 = "Four "
Case 5
M3 = "Five "
Case 6
M3 = "Six "
Case 7
M3 = "Seven "
Case 8
M3 = "Eight "
Case 9
M3 = "Nine "
End Select
End If
Million = M1 & M2 & M3 & Million
'----------------------------------------------------
'''Do thousand
If Digit4 <> 0 Or Digit5 <> 0 Or Digit6 <> 0 Then
Thousand = "Thousand "
End If
Dim T1
T1 = Digit4
Select Case T1
Case 0
T1 = ""
Case 1
T1 = "One Hundred "
Case 2
T1 = "Two Hundred "
Case 3
T1 = "Three Hundred "
Case 4
T1 = "Four Hundred "
Case 5
T1 = "Five Hundred "
Case 6
T1 = "Six Hundred "
Case 7
T1 = "Seven Hundred "
Case 8
T1 = "Eight Hundred "
Case 9
T1 = "Nine Hundred "
End Select
Dim T2
T2 = Digit5
Select Case T2
Case 0
T2 = ""
Case 1
T2 = ""
Case 2
T2 = "Twenty "
Case 3
T2 = "Thirty "
Case 4
T2 = "Forty "
Case 5
T2 = "Fifty "
Case 6
T2 = "Sixty "
Case 7
T2 = "Seventy "
Case 8
T2 = "Eighty "
Case 9
T2 = "Ninety "
End Select
Dim T3
T3 = Digit6
If Digit5 = 1 Then 'check against the number before
Select Case T3
Case 0
T3 = "Ten "
Case 1
T3 = "Eleven "
Case 2
T3 = "Twelve "
Case 3
T3 = "Thirteen "
Case 4
T3 = "Fourteen "
Case 5
T3 = "Fifteen "
Case 6
T3 = "Sixteen "
Case 7
T3 = "Seventeen "
Case 8
T3 = "Eighteen "
Case 9
T3 = "Nineteen "
End Select
Else
Select Case T3
Case 0
T3 = ""
Case 1
T3 = "One "
Case 2
T3 = "Two "
Case 3
T3 = "Three "
Case 4
T3 = "Four "
Case 5
T3 = "Five "
Case 6
T3 = "Six "
Case 7
T3 = "Seven "
Case 8
T3 = "Eight "
Case 9
T3 = "Nine "
End Select
End If
Thousand = T1 & T2 & T3 & Thousand
'----------------------------------------------------
'''Do hundred
If Digit6 <> 0 Or Digit7 <> 0 Or Digit8 <> 0 Then
Hundred = "Hundred "
End If
Dim H1
H1 = Digit7
Select Case H1
Case 0
H1 = ""
Case 1
H1 = "One Hundred "
Case 2
H1 = "Two Hundred "
Case 3
H1 = "Three Hundred "
Case 4
H1 = "Four Hundred "
Case 5
H1 = "Five Hundred "
Case 6
H1 = "Six Hundred "
Case 7
H1 = "Seven Hundred "
Case 8
H1 = "Eight Hundred "
Case 9
H1 = "Nine Hundred "
End Select
Dim H2
H2 = Digit8
Select Case H2
Case 0
H2 = ""
Case 1
H2 = ""
Case 2
H2 = "Twenty "
Case 3
H2 = "Thirty "
Case 4
H2 = "Forty "
Case 5
H2 = "Fifty "
Case 6
H2 = "Sixty "
Case 7
H2 = "Seventy "
Case 8
H2 = "Eighty "
Case 9
H2 = "Ninety "
End Select
Dim H3
H3 = Digit9
If Digit8 = 1 Then 'check against the number before
Select Case H3
Case 0
H3 = "Ten "
Case 1
H3 = "Eleven "
Case 2
H3 = "Twelve "
Case 3
H3 = "Thirteen "
Case 4
H3 = "Fourteen "
Case 5
H3 = "Fifteen "
Case 6
H3 = "Sixteen "
Case 7
H3 = "Seventeen "
Case 8
H3 = "Eighteen "
Case 9
H3 = "Nineteen "
End Select
Else
Select Case H3
Case 0
H3 = ""
Case 1
H3 = "One "
Case 2
H3 = "Two "
Case 3
H3 = "Three "
Case 4
H3 = "Four "
Case 5
H3 = "Five "
Case 6
H3 = "Six "
Case 7
H3 = "Seven "
Case 8
H3 = "Eight "
Case 9
H3 = "Nine "
End Select
End If
Hundred = H1 & H2 & H3
'----------------------------------------------------
'Do decimal
Dim D1
D1 = Digit11
Select Case D1
Case 0
D1 = ""
Case 1
D1 = ""
Case 2
D1 = "Twenty "
Case 3
D1 = "Thirty "
Case 4
D1 = "Forty "
Case 5
D1 = "Fifty "
Case 6
D1 = "Sixty "
Case 7
D1 = "Seventy "
Case 8
D1 = "Eighty "
Case 9
D1 = "Ninety "
End Select
Dim D2
D2 = Digit12
If Digit11 = 1 Then 'check against the number before
Select Case D2
Case 0
D2 = "Ten "
Case 1
D2 = "Eleven "
Case 2
D2 = "Twelve "
Case 3
D2 = "Thirteen "
Case 4
D2 = "Fourteen "
Case 5
D2 = "Fifteen "
Case 6
D2 = "Sixteen "
Case 7
D2 = "Seventeen "
Case 8
D2 = "Eighteen "
Case 9
D2 = "Nineteen "
End Select
Else
Select Case D2
Case 0
D2 = ""
Case 1
D2 = "One "
Case 2
D2 = "Two "
Case 3
D2 = "Three "
Case 4
D2 = "Four "
Case 5
D2 = "Five "
Case 6
D2 = "Six "
Case 7
D2 = "Seven "
Case 8
D2 = "Eight "
Case 9
D2 = "Nine "
End Select
End If
myDecimal = D1 & D2
'--------------------------------------------------
'--------------------------------------------------
If Million = "" And Thousand = "" And Hundred = "" Then
MyDollar = ""
Space = ""
Separator = ""
Else: Space = " "
Separator = "And "
End If
If myDecimal = "" Then
MyCent = ""
Separator = ""
End If
If txRM = "" Then
Space = "" 'So that the 1st digit will not have a gap in front
End If
txtString = MyDollar & Space & Million & Thousand & Hundred & Separator & MyCent & myDecimal
'ActiveCell = txtString
'ActiveCell.Offset(1, 0).Select
Next i
Exit Function
Else
MsgBox "The cell must contain a number", vbCritical, "Macro Error"
End If
End 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!
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. Form
2. Reference Cell
3. Output Cell
4. Tombol radio English
5. Tombol radio Bahasa Indonesia
6. Tombol Convert
7. Tombol Exit
Untuk scriptnya pilih View > Code lalu gunakan script berikut:
1. Form
Private Sub UserForm_Activate()
opt_english.Value = True
cmd_run.SetFocus
End Sub
Private Sub UserForm_QueryClose _
(cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
cancel = True
End If
End Sub
6. Tombol Convert
Private 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 If
End Sub
7. Tombol Exit
Private Sub cmd_cancel_Click()
Unload Me
End Sub
Selanjutnya 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 With
End Sub
Sampai 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 String
Dim 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 = Temp
End 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 Then
Dim MyNum, Num1, NumLength, txString
Dim Million, Thousand, Hundred, myDecimal
Dim MyDollar, MyCent
Dim Space, Separator
Dim Digit1, Digit2, Digit3, Digit4, Digit5
Dim Digit6, Digit7, Digit8, Digit9
Dim Digit11, Digit12 'Decimals
Dim txRM
Dim Rng, i
Rng = Selection.Rows.Count
For i = 1 To Rng
MyDollar = "IDR " 'Must be within the
MyCent = "Sen " 'For Next Loop
'--------------------------------------------------
Digit1 = 0 'Resets numbers
Digit2 = 0
Digit3 = 0
Digit4 = 0
Digit5 = 0
Digit6 = 0
Digit7 = 0
Digit8 = 0
Digit9 = 0
Digit11 = 0
Digit12 = 0
Million = ""
Thousand = ""
Hundred = ""
myDecimal = ""
'--------------------------------------------------
Num1 = jumlah
MyNum = Format(Num1, "#0.00") 'Shows 2 decimal places
NumLength = Len(MyNum) 'Determines the length of the number
Select Case NumLength 'Length determines the
Case 12 'position of the text boxes
Digit1 = 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 11
Digit2 = 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 10
Digit3 = 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 9
Digit4 = 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 8
Digit5 = 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 7
Digit6 = 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 6
Digit7 = 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 5
Digit8 = Mid(MyNum, 1, 1)
Digit9 = Mid(MyNum, 2, 1)
Digit11 = Mid(MyNum, 4, 1)
Digit12 = Mid(MyNum, 5, 1)
Case 4
Digit9 = Mid(MyNum, 1, 1)
Digit11 = Mid(MyNum, 3, 1)
Digit12 = Mid(MyNum, 4, 1)
Case 3
Digit11 = Mid(MyNum, 2, 1)
Digit12 = Mid(MyNum, 3, 1)
Case 2
Digit12 = Mid(MyNum, 2, 1)
End Select
'--------------------------------------------------
'''Do million
If Digit1 <> 0 Or Digit2 <> 0 Or Digit3 <> 0 Then
Million = "Million "
End If
Dim M1
M1 = Digit1
Select Case M1
Case 0
M1 = ""
Case 1
M1 = "One Hundred "
Case 2
M1 = "Two Hundred "
Case 3
M1 = "Three Hundred "
Case 4
M1 = "Four Hundred "
Case 5
M1 = "Five Hundred "
Case 6
M1 = "Six Hundred "
Case 7
M1 = "Seven Hundred "
Case 8
M1 = "Eight Hundred "
Case 9
M1 = "Nine Hundred "
End Select
Dim M2
M2 = Digit2
Select Case M2
Case 0
M2 = ""
Case 1
M2 = ""
Case 2
M2 = "Twenty "
Case 3
M2 = "Thirty "
Case 4
M2 = "Forty "
Case 5
M2 = "Fifty "
Case 6
M2 = "Sixty "
Case 7
M2 = "Seventy "
Case 8
M2 = "Eighty "
Case 9
M2 = "Ninety "
End Select
Dim M3
M3 = Digit3
If Digit2 = 1 Then 'check against the number before
Select Case M3
Case 0
M3 = "Ten "
Case 1
M3 = "Eleven "
Case 2
M3 = "Twelve "
Case 3
M3 = "Thirteen "
Case 4
M3 = "Fourteen "
Case 5
M3 = "Fifteen "
Case 6
M3 = "Sixteen "
Case 7
M3 = "Seventeen "
Case 8
M3 = "Eighteen "
Case 9
M3 = "Nineteen "
End Select
Else
Select Case M3
Case 0
M3 = ""
Case 1
M3 = "One "
Case 2
M3 = "Two "
Case 3
M3 = "Three "
Case 4
M3 = "Four "
Case 5
M3 = "Five "
Case 6
M3 = "Six "
Case 7
M3 = "Seven "
Case 8
M3 = "Eight "
Case 9
M3 = "Nine "
End Select
End If
Million = M1 & M2 & M3 & Million
'----------------------------------------------------
'''Do thousand
If Digit4 <> 0 Or Digit5 <> 0 Or Digit6 <> 0 Then
Thousand = "Thousand "
End If
Dim T1
T1 = Digit4
Select Case T1
Case 0
T1 = ""
Case 1
T1 = "One Hundred "
Case 2
T1 = "Two Hundred "
Case 3
T1 = "Three Hundred "
Case 4
T1 = "Four Hundred "
Case 5
T1 = "Five Hundred "
Case 6
T1 = "Six Hundred "
Case 7
T1 = "Seven Hundred "
Case 8
T1 = "Eight Hundred "
Case 9
T1 = "Nine Hundred "
End Select
Dim T2
T2 = Digit5
Select Case T2
Case 0
T2 = ""
Case 1
T2 = ""
Case 2
T2 = "Twenty "
Case 3
T2 = "Thirty "
Case 4
T2 = "Forty "
Case 5
T2 = "Fifty "
Case 6
T2 = "Sixty "
Case 7
T2 = "Seventy "
Case 8
T2 = "Eighty "
Case 9
T2 = "Ninety "
End Select
Dim T3
T3 = Digit6
If Digit5 = 1 Then 'check against the number before
Select Case T3
Case 0
T3 = "Ten "
Case 1
T3 = "Eleven "
Case 2
T3 = "Twelve "
Case 3
T3 = "Thirteen "
Case 4
T3 = "Fourteen "
Case 5
T3 = "Fifteen "
Case 6
T3 = "Sixteen "
Case 7
T3 = "Seventeen "
Case 8
T3 = "Eighteen "
Case 9
T3 = "Nineteen "
End Select
Else
Select Case T3
Case 0
T3 = ""
Case 1
T3 = "One "
Case 2
T3 = "Two "
Case 3
T3 = "Three "
Case 4
T3 = "Four "
Case 5
T3 = "Five "
Case 6
T3 = "Six "
Case 7
T3 = "Seven "
Case 8
T3 = "Eight "
Case 9
T3 = "Nine "
End Select
End If
Thousand = T1 & T2 & T3 & Thousand
'----------------------------------------------------
'''Do hundred
If Digit6 <> 0 Or Digit7 <> 0 Or Digit8 <> 0 Then
Hundred = "Hundred "
End If
Dim H1
H1 = Digit7
Select Case H1
Case 0
H1 = ""
Case 1
H1 = "One Hundred "
Case 2
H1 = "Two Hundred "
Case 3
H1 = "Three Hundred "
Case 4
H1 = "Four Hundred "
Case 5
H1 = "Five Hundred "
Case 6
H1 = "Six Hundred "
Case 7
H1 = "Seven Hundred "
Case 8
H1 = "Eight Hundred "
Case 9
H1 = "Nine Hundred "
End Select
Dim H2
H2 = Digit8
Select Case H2
Case 0
H2 = ""
Case 1
H2 = ""
Case 2
H2 = "Twenty "
Case 3
H2 = "Thirty "
Case 4
H2 = "Forty "
Case 5
H2 = "Fifty "
Case 6
H2 = "Sixty "
Case 7
H2 = "Seventy "
Case 8
H2 = "Eighty "
Case 9
H2 = "Ninety "
End Select
Dim H3
H3 = Digit9
If Digit8 = 1 Then 'check against the number before
Select Case H3
Case 0
H3 = "Ten "
Case 1
H3 = "Eleven "
Case 2
H3 = "Twelve "
Case 3
H3 = "Thirteen "
Case 4
H3 = "Fourteen "
Case 5
H3 = "Fifteen "
Case 6
H3 = "Sixteen "
Case 7
H3 = "Seventeen "
Case 8
H3 = "Eighteen "
Case 9
H3 = "Nineteen "
End Select
Else
Select Case H3
Case 0
H3 = ""
Case 1
H3 = "One "
Case 2
H3 = "Two "
Case 3
H3 = "Three "
Case 4
H3 = "Four "
Case 5
H3 = "Five "
Case 6
H3 = "Six "
Case 7
H3 = "Seven "
Case 8
H3 = "Eight "
Case 9
H3 = "Nine "
End Select
End If
Hundred = H1 & H2 & H3
'----------------------------------------------------
'Do decimal
Dim D1
D1 = Digit11
Select Case D1
Case 0
D1 = ""
Case 1
D1 = ""
Case 2
D1 = "Twenty "
Case 3
D1 = "Thirty "
Case 4
D1 = "Forty "
Case 5
D1 = "Fifty "
Case 6
D1 = "Sixty "
Case 7
D1 = "Seventy "
Case 8
D1 = "Eighty "
Case 9
D1 = "Ninety "
End Select
Dim D2
D2 = Digit12
If Digit11 = 1 Then 'check against the number before
Select Case D2
Case 0
D2 = "Ten "
Case 1
D2 = "Eleven "
Case 2
D2 = "Twelve "
Case 3
D2 = "Thirteen "
Case 4
D2 = "Fourteen "
Case 5
D2 = "Fifteen "
Case 6
D2 = "Sixteen "
Case 7
D2 = "Seventeen "
Case 8
D2 = "Eighteen "
Case 9
D2 = "Nineteen "
End Select
Else
Select Case D2
Case 0
D2 = ""
Case 1
D2 = "One "
Case 2
D2 = "Two "
Case 3
D2 = "Three "
Case 4
D2 = "Four "
Case 5
D2 = "Five "
Case 6
D2 = "Six "
Case 7
D2 = "Seven "
Case 8
D2 = "Eight "
Case 9
D2 = "Nine "
End Select
End If
myDecimal = D1 & D2
'--------------------------------------------------
'--------------------------------------------------
If Million = "" And Thousand = "" And Hundred = "" Then
MyDollar = ""
Space = ""
Separator = ""
Else: Space = " "
Separator = "And "
End If
If myDecimal = "" Then
MyCent = ""
Separator = ""
End If
If txRM = "" Then
Space = "" 'So that the 1st digit will not have a gap in front
End If
txtString = MyDollar & Space & Million & Thousand & Hundred & Separator & MyCent & myDecimal
'ActiveCell = txtString
'ActiveCell.Offset(1, 0).Select
Next i
Exit Function
Else
MsgBox "The cell must contain a number", vbCritical, "Macro Error"
End If
End 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!
0 komentar:
Posting Komentar