Baru kali ini saya membuat ebook / artikel mengenai excell
dan vb 6 setelah 2 minggu sibuk mengurus tentang pengetahuan bisnis online
serta banyaknya tawaran untuk memasang iklan ya. Walaupun kecil tapi mereka
melihat manfaatnya... baiklah masuk pada intinya
1.
Bagaimana membuat
terbilang di visual basic
2.
Bagaimana membuat
fungsi Terbilang di Microsoft Excell 2007
Walapun
bagi sebagian mereka apa yang saya buat ini tak bermanfaat dan mereka sudah
paham namun ada baiknya saya berbagi 
Isilah dengan
koding yang saya tulis di bawah ini di module
Public Function Terbilangindonesia(strAngka As String) As
String
Dim strJmlHuruf$,
intPecahan As Integer
Dim strPecahan$,
Urai$, Bil1$, strTot$, Bil2$
Dim X As Integer, Y
As Integer, z As Integer
Dim i As Integer
On Error GoTo Pesan
Dim strValid As
String, huruf As String * 1
'Periksa setiap
karakter yg diketikkan ke kotak UserID
strValid =
"1234567890"
For i% = 1 To
Len(strAngka)
huruf =
Chr(Asc(Mid(strAngka, i%, 1)))
If InStr(strValid,
huruf) = 0 Then
Set
AngkaTerbilang = Nothing
MsgBox
"Harus karakter angka!", _
vbCritical, "Karakter Tidak Valid"
Exit Function
End If
Next i%
If strAngka =
"" Then Exit Function
If
Len(Trim(strAngka)) > 15 Then GoTo Pesan
strJmlHuruf =
LTrim(strAngka)
If (intPecahan = 0)
Then
strPecahan =
""
Else
strPecahan =
""
End If
X = 0
Y = 0
Urai = ""
While (X <
Len(strJmlHuruf))
X = X + 1
strTot =
Mid(strJmlHuruf, X, 1)
Y = Y +
Val(strTot)
z =
Len(strJmlHuruf) - X + 1
Select Case
Val(strTot)
'Case 0: Bil1 =
"Nol "
Case 1
If (z = 1 Or z =
7 Or z = 10 Or z = 13) Then
Bil1 =
"satu "
ElseIf (z = 4)
Then
If (X = 1)
Then
Bil1 =
"se"
Else
Bil1 =
"satu "
End If
ElseIf (z = 2 Or
z = 5 Or z = 8 Or z = 11 Or z = 14) Then
X = X + 1
strTot =
Mid(strJmlHuruf, X, 1)
z =
Len(strJmlHuruf) - X + 1
Bil2 =
""
Select Case
Val(strTot)
Case
0: Bil1 = "sepuluh "
Case
1: Bil1 = "sebelas "
Case
2: Bil1 = "dua belas "
Case
3: Bil1 = "tiga belas "
Case
4: Bil1 = "empat belas "
Case
5: Bil1 = "lima belas "
Case
6: Bil1 = "enam belas "
Case
7: Bil1 = "tujuh belas "
Case
8: Bil1 = "delapan belas "
Case 9:
Bil1 = "sembilan belas "
End Select
Else
Bil1 =
"se"
End If
Case 2: Bil1 = "dua "
Case 3: Bil1 = "tiga "
Case 4: Bil1 = "empat "
Case 5: Bil1 = "lima "
Case 6: Bil1 = "enam "
Case 7: Bil1 = "tujuh "
Case 8: Bil1 = "delapan "
Case 9: Bil1 = "sembilan "
Case Else
Bil1 =
""
End Select
If (Val(strTot)
> 0) Then
If (z = 2 Or z
= 5 Or z = 8 Or z = 11 Or z = 14) Then
Bil2 =
"puluh "
ElseIf (z = 3
Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then
Bil2 =
"ratus "
Else
Bil2 =
""
End If
Else
Bil2 =
""
End If
If (Y > 0) Then
Select Case z
Case
4: Bil2 = Bil2 + "ribu "
Y = 0
Case
7: Bil2 = Bil2 + "juta "
Y = 0
Case
10: Bil2 = Bil2 + "milyar "
Y = 0
Case 13:
Bil2 = Bil2 + "trilyun "
Y = 0
End Select
End If
Urai = Urai + Bil1
+ Bil2
Wend
Urai = Urai +
strPecahan
Terbilangindonesia =
Urai
Exit Function
Pesan:
Terbilangindonesia =
"(maksimal 15 digit)"
End Function
·
Simpanlah hasil
module dengan ekstensi. Bas
· Maka add form
kemudian tambahkan sebuah textbox1 dan textbox2
·
Pada textbox1
digunakan untuk nilai angka dan textbox2
sebagai nilai huruf
Isi kode dengan
cara double klik di textbox1 dengan isi
” txtHasil.Text
= TerbilangIndonesia(Val(txtAngka.Text))”
Konversi
excell ini biasanya penting bagi adm bagian keuangan ataupun kasir kalau
sekiranya ianya seorang programer itu hal yang gampang bukan ? nah setelah
searching dan saya pun bisa membuatnya dengan mengikuti langkahnya ..
Ikuti langkah
di bawah ini
1.
Buka quick
acces
2. Excell option
3.
Tab pupolar
4. Centang show developher in the ribbon
5.
Klik tab
developer
6. Visual basic
7.
Pilih insert
8. Module
9. Copy source yang ini
Public Function
Terbilangindonesia(strAngka As String) As String
Dim strJmlHuruf$, intPecahan As Integer
Dim strPecahan$, Urai$, Bil1$, strTot$, Bil2$
Dim X As Integer, Y As Integer, z As Integer
Dim i As Integer
On Error GoTo Pesan
Dim strValid As String, huruf As String * 1
'Periksa setiap karakter yg diketikkan ke kotak UserID
strValid = "1234567890"
For i% = 1 To Len(strAngka)
huruf = Chr(Asc(Mid(strAngka, i%, 1)))
If InStr(strValid, huruf) = 0 Then
Set AngkaTerbilang = Nothing
MsgBox "Harus karakter angka!", _
vbCritical, "Karakter Tidak
Valid"
Exit Function
End If
Next i%
If strAngka = "" Then Exit Function
If Len(Trim(strAngka)) > 15 Then GoTo Pesan
strJmlHuruf = LTrim(strAngka)
If (intPecahan = 0) Then
strPecahan = ""
Else
strPecahan = ""
End If
X
= 0
Y
= 0
Urai = ""
While (X < Len(strJmlHuruf))
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
Y = Y + Val(strTot)
z = Len(strJmlHuruf) - X + 1
Select Case Val(strTot)
'Case 0: Bil1 = "Nol "
Case 1
If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then
Bil1 = "satu "
ElseIf (z = 4) Then
If (X = 1) Then
Bil1 = "se"
Else
Bil1 = "satu "
End If
ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
z = Len(strJmlHuruf) - X + 1
Bil2 = ""
Select Case Val(strTot)
Case 0: Bil1 = "sepuluh "
Case 1: Bil1 = "sebelas "
Case 2: Bil1 = "dua belas "
Case 3: Bil1 = "tiga belas "
Case 4: Bil1 = "empat belas "
Case 5: Bil1 = "lima belas "
Case 6: Bil1 = "enam belas "
Case 7: Bil1 = "tujuh belas "
Case 8: Bil1 = "delapan belas "
Case 9: Bil1 = "sembilan belas "
End Select
Else
Bil1 = "se"
End If
Case 2: Bil1 = "dua "
Case 3: Bil1 = "tiga "
Case 4: Bil1 = "empat
"
Case 5: Bil1 = "lima "
Case 6: Bil1 = "enam "
Case 7: Bil1 = "tujuh
"
Case 8:
Bil1 = "delapan "
Case 9: Bil1 = "sembilan
"
Case Else
Bil1 = ""
End Select
If (Val(strTot) > 0) Then
If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
Bil2 = "puluh "
ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then
Bil2 = "ratus "
Else
Bil2 = ""
End If
Else
Bil2 = ""
End If
If (Y > 0) Then
Select Case z
Case 4: Bil2 = Bil2 + "ribu "
Y = 0
Case 7: Bil2 = Bil2 + "juta "
Y = 0
Case 10: Bil2 = Bil2 + "milyar "
Y = 0
Case 13:
Bil2 = Bil2 + "trilyun "
Y = 0
End Select
End If
Urai = Urai + Bil1 + Bil2
Wend
Urai = Urai + strPecahan
Terbilangindonesia = Urai
Exit Function
Pesan:
Terbilangindonesia = "(maksimal 15 digit)"
End Function
10.
File
11. Close and return microsoft excell atau
kamu bisa tekan ALT + q
Tidak ada komentar:
Posting Komentar