Code VBA Macro Add Ins TERBILANG

1. Buka lembar kerja atau Worksheet pada Excel anda.

2. Tekan Ctrl+F11 atau klik menu ribbon, pilih Developer

3. kemudian pilih Visul Basic

4. selanjutnya tekan Ctrl+R ataau pilih Project Explorer

5. klik kanan pada Project atau nama file yang sedang anda gunakan pilih insert modul

6. lalu input code beikut :


' Collection of Function

' Macro created March 29, 2008 by DESAINER (Poeank Jhonk S.)

' Macro edited April 20, 2008

' http://bumiseran.blogspot.com


Function TERBILANG(Angka As Double, Text_Satuan As String) As String


Dim SebutanRupiah As String, Ratus As Long, Ribu As Long, Juta As Long, Milyar As Long


JOS = Chr(74) & Chr(79) & Chr(83)

SebutBilangan = "satu dua tiga empat lima " '9 char

SebutBilangan = SebutBilangan & "enam tujuh delapan sembilan "




If Angka < 0 Then

TandaRincian = "minus "

ElseIf Angka = 0 Then

TandaRincian = "nol "

Else

TandaRincian = ""

End If



If Abs(Angka) >= 1000000000000# Then

TERBILANG = "#TERLALU BESAR! Maks < trilyun. Hubungi " & JOS & " untuk Bantuan."

Exit Function

End If



Angka = Abs(Angka)

Sen = PECAHAN(Angka)



If Sen <> 0 Then

TERBILANG = "#PECAHAN! Hubungi " & JOS & " untuk Bantuan."

Exit Function

End If



SebutanRupiah = Right("000000000000" & Str$(Angka), 12)

Ratus = Val(Right(SebutanRupiah, 3))

Ribu = Val(Mid(SebutanRupiah, 7, 3))

Juta = Val(Mid(SebutanRupiah, 4, 3))

Milyar = Val(Left(SebutanRupiah, 3))



If Ratus > 0 Then

TextRupiah = Right("000" & Str$(Ratus), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1

If DigitSatuan = 0 Then

TerbilangPuluhan = " sepuluh "

ElseIf DigitSatuan = 1 Then

TerbilangPuluhan = " sebelas "

Else

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " belas "

End If

Case Is > 1

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " puluh " & TerbilangSatuan

End Select

TerbilangPuluhan = Trim(TerbilangPuluhan)

Select Case DigitRatusan

Case Is = 0

TerbilangRatusan = TerbilangPuluhan

Case Is = 1

TerbilangRatusan = " seratus " & TerbilangPuluhan

Case Is > 1

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " ratus " & TerbilangPuluhan

End Select

Rincian = Trim(TerbilangRatusan)

End If



If Ribu = 1 Then

Rincian = "seribu " & Rincian

ElseIf Ribu > 1 Then



TextRupiah = Right("000" & Str$(Ribu), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1

If DigitSatuan = 0 Then

TerbilangPuluhan = " sepuluh "

ElseIf DigitSatuan = 1 Then

TerbilangPuluhan = " sebelas "

Else

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " belas "

End If

Case Is > 1

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " puluh " & TerbilangSatuan

End Select

TerbilangPuluhan = Trim(TerbilangPuluhan)

Select Case DigitRatusan

Case Is = 0

TerbilangRatusan = TerbilangPuluhan

Case Is = 1

TerbilangRatusan = " seratus " & TerbilangPuluhan

Case Is > 1

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " ratus " & TerbilangPuluhan

End Select

Rincian = Trim(TerbilangRatusan) & " ribu " & Rincian

End If



If Juta > 0 Then

TextRupiah = Right("000" & Str$(Juta), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1

If DigitSatuan = 0 Then

TerbilangPuluhan = " sepuluh "

ElseIf DigitSatuan = 1 Then

TerbilangPuluhan = " sebelas "

Else

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " belas "

End If

Case Is > 1

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " puluh " & TerbilangSatuan

End Select

TerbilangPuluhan = Trim(TerbilangPuluhan)

Select Case DigitRatusan

Case Is = 0

TerbilangRatusan = TerbilangPuluhan

Case Is = 1

TerbilangRatusan = " seratus " & TerbilangPuluhan

Case Is > 1

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " ratus " & TerbilangPuluhan

End Select

Rincian = Trim(TerbilangRatusan) & " juta " & Rincian

End If



If Milyar > 0 Then

TextRupiah = Right("000" & Str$(Milyar), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1

If DigitSatuan = 0 Then

TerbilangPuluhan = " sepuluh "

ElseIf DigitSatuan = 1 Then

TerbilangPuluhan = " sebelas "

Else

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitSatuan * 9 - 8, 9)) & " belas "

End If

Case Is > 1

TerbilangPuluhan = Trim(Mid(SebutBilangan, DigitPuluhan * 9 - 8, 9)) & " puluh " & TerbilangSatuan

End Select

TerbilangPuluhan = Trim(TerbilangPuluhan)

Select Case DigitRatusan

Case Is = 0

TerbilangRatusan = TerbilangPuluhan

Case Is = 1

TerbilangRatusan = " seratus " & TerbilangPuluhan

Case Is > 1

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 9 - 8, 9)) & " ratus " & TerbilangPuluhan

End Select

Rincian = Trim(TerbilangRatusan) & " milyar " & Rincian

End If

TERBILANG = TandaRincian & Trim(Rincian) & " " & Text_Satuan

End Function

'

'

Function PECAHAN(Angka As Double) As Double

PECAHAN = Angka - Fix(Angka)

End Function

'

'

Function JUDUL(Text As Variant) As Variant

' Accepts: a text value

' Purpose: converts first letter of each word to uppercase

' Returns: converted text value




Dim ptr As Integer

Dim theString As String

Dim currChar As String, prevChar As String




If Text = "" Then

JUDUL = ""

Exit Function

End If




theString = CStr(Text)

For ptr = 1 To Len(theString)

currChar = Mid$(theString, ptr, 1)



Select Case prevChar



Case "A" To "Z", "a" To "z"

Mid(theString, ptr, 1) = LCase(currChar)



Case Else

Mid(theString, ptr, 1) = UCase(currChar)



End Select

prevChar = currChar

Next ptr

JUDUL = CVar(theString)

End Function

'

'

Function KALIMAT(Text As Variant) As Variant

' Accepts: a text value

' Purpose: converts first letter of sentence to uppercase

' Returns: converted text value




Dim theString As String, currChar As String




If Text = "" Then

KALIMAT = ""

Exit Function

End If




theString = CStr(Text)

currChar = LCase(theString)

Mid(currChar, 1, 1) = UCase(currChar)

KALIMAT = CVar(currChar)

End Function

'

'

Function SAYS(Angka As Double, Text_Satuan As String) As String



Dim SebutanRupiah As String, Ratus As Long, Ribu As Long, Juta As Long, Milyar As Long




JOS = Chr(74) & Chr(79) & Chr(83)

SebutBilangan = "one two three four five six seven eight nine " ' 6 char

SebutBilanganBelas = "eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen " '10 char

SebutBilanganPuluh = "ten twenty thirty forty fifty sixty seventy eighty ninety " '8 char




If Angka < 0 Then

TandaRincian = "minus "

ElseIf Angka = 0 Then

TandaRincian = "nul "

Else

TandaRincian = ""

End If



If Abs(Angka) >= 1000000000000# Then

SAYS = "#TOO BIG! Call " & JOS & " for Help."

Exit Function

End If



Angka = Abs(Angka)

Sen = PECAHAN(Angka)



If Sen <> 0 Then

SAYS = "#FRACTION! Call " & JOS & " for Help."

Exit Function

End If



TextHubungan = " and "

Hubungan = 0

SebutanRupiah = Right("000000000000" & Str$(Angka), 12)

Ratus = Val(Right(SebutanRupiah, 3))

Ribu = Val(Mid(SebutanRupiah, 7, 3))

Juta = Val(Mid(SebutanRupiah, 4, 3))

Milyar = Val(Left(SebutanRupiah, 3))



If Ratus > 0 Then

TextRupiah = Right("000" & Str$(Ratus), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 6 - 5, 6))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1 And DigitSatuan > 0

TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))

Case Else

TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan

End Select



If DigitRatusan = 0 Then

TerbilangRatusan = TerbilangPuluhan

Else

Select Case TerbilangPuluhan

Case Is = ""

TextHubungan = ""

Case Else

TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)

Hubungan = 1

End Select

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " hundred " & TerbilangPuluhan

End If

Rincian = Trim(TerbilangRatusan)

End If



If Ribu > 0 Then

TextRupiah = Right("000" & Str$(Ribu), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If Hubungan = 1 Then

TextHubungan = ""

ElseIf Rincian <> "" Then

TextHubungan = " and "

Rincian = Trim(TextHubungan & Rincian)

Hubungan = 1

End If



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 6 - 5, 6))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1 And DigitSatuan > 0

TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))

Case Else

TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan

End Select



If DigitRatusan = 0 Then

TerbilangRatusan = TerbilangPuluhan

Else

Select Case TerbilangPuluhan

Case Is = ""

TextHubungan = ""

Case Else

TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)

Hubungan = 1

End Select

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " hundred " & TerbilangPuluhan

End If

Rincian = Trim(TerbilangRatusan) & " thousand " & Rincian

End If



If Juta > 0 Then

TextRupiah = Right("000" & Str$(Juta), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If Hubungan = 1 Then

TextHubungan = ""

ElseIf Rincian <> "" Then

TextHubungan = " and "

Rincian = Trim(TextHubungan & Rincian)

Hubungan = 1

End If



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 6 - 5, 6))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1 And DigitSatuan > 0

TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))

Case Else

TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan

End Select



If DigitRatusan = 0 Then

TerbilangRatusan = TerbilangPuluhan

Else

Select Case TerbilangPuluhan

Case Is = ""

TextHubungan = ""

Case Else

TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)

Hubungan = 1

End Select

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " hundred " & TerbilangPuluhan

End If

Rincian = Trim(TerbilangRatusan) & " million " & Rincian

End If



If Milyar > 0 Then

TextRupiah = Right("000" & Str$(Milyar), 3)

DigitSatuan = Val(Right(TextRupiah, 1))

DigitPuluhan = Val(Mid(TextRupiah, 2, 1))

DigitRatusan = Val(Left(TextRupiah, 1))



If Hubungan = 1 Then

TextHubungan = ""

ElseIf Rincian <> "" Then

TextHubungan = " and "

Rincian = Trim(TextHubungan & Rincian)

Hubungan = 1

End If



If DigitSatuan = 0 Then

TerbilangSatuan = ""

Else

TerbilangSatuan = Trim(Mid(SebutBilangan, DigitSatuan * 6 - 5, 6))

End If



Select Case DigitPuluhan

Case Is = 0

TerbilangPuluhan = TerbilangSatuan

Case Is = 1 And DigitSatuan > 0

TerbilangPuluhan = Trim(Mid(SebutBilanganBelas, DigitSatuan * 10 - 9, 10))

Case Else

TerbilangPuluhan = Trim(Mid(SebutBilanganPuluh, DigitPuluhan * 8 - 7, 8)) & " " & TerbilangSatuan

End Select



If DigitRatusan = 0 Then

TerbilangRatusan = TerbilangPuluhan

Else

Select Case TerbilangPuluhan

Case Is = ""

TextHubungan = ""

Case Else

TerbilangPuluhan = Trim(TextHubungan & TerbilangPuluhan)

Hubungan = 1

End Select

TerbilangRatusan = Trim(Mid(SebutBilangan, DigitRatusan * 6 - 5, 6)) & " hundred " & TerbilangPuluhan

End If

Rincian = Trim(TerbilangRatusan) & " milliard " & Rincian

End If



SAYS = TandaRincian & Trim(Rincian) & " " & Text_Satuan




End Function




Wassalam Semoga bermanfaat, kata Master Guru saya, jangan lupa 5000 dulu, heheheheh.






Contoh File Silahkan Download Disni