Tips Membuat Add In Terbilang Untuk Microsoft Word 2007

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"



Source : http://dhuwuh.blogspot.com/2012/08/tips-membuat-add-in-terbilang-untuk_25.html

Tips Membuat Add In Terbilang Untuk Microsoft Excel 2007 (edisi basi)

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. Copy paste kode dibawah ini pada notepad ("Terbilang dengan akhiran rupiah" atau "Terbilangan tanpa akhiran rupiah")
2. Lalu Save As dengan akhiran "terbilang.xlam" dan taruh terserah anda, contoh c:/My Documents
3. Kemuadian buka excel 2007
4. Excel Option

5.Pilih tabs "Add-Ins", lalu "Go…".

6. Muncul kotak berikut tekan pada tombol "Browse"

7. Cari file yang anda simpan tadi (misal di c:/My Documents)

8. Klik tombol "Ok" lalu akan muncul kotak berikut :

9. Klik Ok lagi untuk menyeselaikan proses pemasangan Add-Ins
Sekarang kita check apakah fungsi tersebut berfungsi. Untuk memakainya anda perlu mengetahui formulanya. Misal angka yang hendak anda buatkan terbilangnya ada di cell "A1", maka formulanya adalah sebagai berikut :
=terbilang(A1,4,"Rupiah.")

Kode Terbilang dengan akhiran rupiah :

Attribute VB_Name = "Module1"
Option Explicit

Function Terbilang(ByVal MyNumber)
Dim Rupiah, Sen, Temp
Dim Des, Desimal, Count, Tmp
Dim IsNeg

ReDim Place(9) As String
Place(2) = "RIBU "
Place(3) = "JUTA "
Place(4) = "MILYAR "
Place(5) = "TRILYUN "

'Ubah angka menjadi string
MyNumber = Round(MyNumber, 2)
MyNumber = Trim(Str(MyNumber))

'Cek bilangan negatif
If Mid(MyNumber, 1, 1) = "-" Then
MyNumber = Right(MyNumber, Len(MyNumber) - 1)
IsNeg = True
End If

'Posisi desimal, 0 jika bil. bulat
Desimal = InStr(MyNumber, ".")
'Pembulatan sen, dua angka di belakang koma
Des = Mid(MyNumber, Desimal + 2)
If Desimal > 0 Then
Tmp = Left(Mid(MyNumber, Desimal + 1) & "00", 2)
If Left(Tmp, 1) = "0" Then
Tmp = Mid(Tmp, 2)
Sen = Satuan(Tmp)
Else
Sen = Puluhan(Tmp)
End If
MyNumber = Trim(Left(MyNumber, Desimal - 1))
End If

Count = 1
Do While MyNumber <> ""
Temp = Ratusan(Right(MyNumber, 3), Count)
If Temp <> "" Then Rupiah = Temp & Place(Count) & Rupiah
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Rupiah
Case ""
Rupiah = "NOL RUPIAH"
Case Else
Rupiah = Rupiah & "RUPIAH"
End Select

Select Case Sen
Case ""
Sen = ""
Case Else
Sen = " DAN " & Sen & "SEN"
End Select

If IsNeg = True Then
Terbilang = "MINUS " & Rupiah & Sen
Else
Terbilang = Rupiah & Sen
End If

End Function


' Mengubah angka 100-999 menjadi teks *
Function Ratusan(ByVal MyNumber, Count)
Dim Result As String
Dim Tmp

If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)

'Mengubah seribu
If MyNumber = "001" And Count = 2 Then
Ratusan = "SE"
Exit Function
End If

'Mengubah ratusan
If Mid(MyNumber, 1, 1) <> "0" Then
If Mid(MyNumber, 1, 1) = "1" Then
Result = "SERATUS "
Else
Result = Satuan(Mid(MyNumber, 1, 1)) & "RATUS "
End If
End If

'Mengubah puluhan dan satuan
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & Puluhan(Mid(MyNumber, 2))
Else
Result = Result & Satuan(Mid(MyNumber, 3))
End If

Ratusan = Result

End Function


'*******************
' Mengubah puluhan *
Function Puluhan(TeksPuluhan)
Dim Result As String

Result = ""
' nilai antara 10-19
If Val(Left(TeksPuluhan, 1)) = 1 Then
Select Case Val(TeksPuluhan)
Case 10: Result = "SEPULUH "
Case 11: Result = "SEBELAS "
Case Else
Result = Satuan(Mid(TeksPuluhan, 2)) & "BELAS "
End Select
' nilai antara 20-99
Else
Result = Satuan(Mid(TeksPuluhan, 1, 1)) _
& "PULUH "
Result = Result & Satuan(Right(TeksPuluhan, 1))
'satuan
End If
Puluhan = Result
End Function


'********************************
' Mengubah satuan menjadi teks. *
Function Satuan(Digit)
Select Case Val(Digit)
Case 1: Satuan = "SATU "
Case 2: Satuan = "DUA "
Case 3: Satuan = "TIGA "
Case 4: Satuan = "EMPAT "
Case 5: Satuan = "LIMA "
Case 6: Satuan = "ENAM "
Case 7: Satuan = "TUJUH "
Case 8: Satuan = "DELAPAN "
Case 9: Satuan = "SEMBILAN "
Case Else: Satuan = ""
End Select
End Function

Kode terbilang tanpa akhiran rupiah :

Function Terbilang(ByVal MyNumber)
Dim Rupiah, Sen, Temp
Dim Des, Desimal, Count, Tmp
Dim IsNeg

ReDim Place(9) As String
Place(2) = "ribu "
Place(3) = "juta "
Place(4) = "milyar "
Place(5) = "trilyun "

'Ubah angka menjadi string
MyNumber = Round(MyNumber, 2)
MyNumber = Trim(Str(MyNumber))

'Cek bilangan negatif
If Mid(MyNumber, 1, 1) = "-" Then
MyNumber = Right(MyNumber, Len(MyNumber) - 1)
IsNeg = True
End If

'Posisi desimal, 0 jika bil. bulat
Desimal = InStr(MyNumber, ".")
'Pembulatan sen, dua angka di belakang koma
Des = Mid(MyNumber, Desimal + 2)
If Desimal > 0 Then
Tmp = Left(Mid(MyNumber, Desimal + 1) & "00", 2)
If Left(Tmp, 1) = "0" Then
Tmp = Mid(Tmp, 2)
Sen = Satuan(Tmp)
Else
Sen = Puluhan(Tmp)
End If
MyNumber = Trim(Left(MyNumber, Desimal - 1))
End If

Count = 1
Do While MyNumber <> ""
Temp = Ratusan(Right(MyNumber, 3), Count)
If Temp <> "" Then Rupiah = Temp & Place(Count) & Rupiah
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Rupiah
Case ""
Rupiah = "nol rupiah"
Case Else
Rupiah = Rupiah & "rupiah"
End Select

Select Case Sen
Case ""
Sen = ""
Case Else
Sen = " dan " & Sen & "sen"
End Select

If IsNeg = True Then
Terbilang = "minus " & Rupiah & Sen
Else
Terbilang = Rupiah & Sen
End If

End Function


'**************************************
' Mengubah angka 100-999 menjadi teks *
'**************************************
Function Ratusan(ByVal MyNumber, Count)
Dim Result As String
Dim Tmp

If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)

'Mengubah seribu
If MyNumber = "001" And Count = 2 Then
Ratusan = "se"
Exit Function
End If

'Mengubah ratusan
If Mid(MyNumber, 1, 1) <> "0" Then
If Mid(MyNumber, 1, 1) = "1" Then
Result = "seratus "
Else
Result = Satuan(Mid(MyNumber, 1, 1)) & "ratus "
End If
End If

'Mengubah puluhan dan satuan
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & Puluhan(Mid(MyNumber, 2))
Else
Result = Result & Satuan(Mid(MyNumber, 3))
End If

Ratusan = Result

End Function


'*******************
' Mengubah puluhan *
'*******************
Function Puluhan(TeksPuluhan)
Dim Result As String

Result = ""
' nilai antara 10-19
If Val(Left(TeksPuluhan, 1)) = 1 Then
Select Case Val(TeksPuluhan)
Case 10: Result = "sepuluh "
Case 11: Result = "sebelas "
Case Else
Result = Satuan(Mid(TeksPuluhan, 2)) & "belas "
End Select
' nilai antara 20-99
Else
Result = Satuan(Mid(TeksPuluhan, 1, 1)) _
& "puluh "
Result = Result & Satuan(Right(TeksPuluhan, 1))
'satuan
End If
Puluhan = Result
End Function


'********************************
' Mengubah satuan menjadi teks. *
'********************************
Function Satuan(Digit)
Select Case Val(Digit)
Case 1: Satuan = "satu "
Case 2: Satuan = "dua "
Case 3: Satuan = "tiga "
Case 4: Satuan = "empat "
Case 5: Satuan = "lima "
Case 6: Satuan = "enam "
Case 7: Satuan = "tujuh "
Case 8: Satuan = "delapan "
Case 9: Satuan = "sembilan "
Case Else: Satuan = ""
End Select
End Function

Source : http://dhuwuh.blogspot.com/2012/08/tips-membuat-add-in-terbilang-untuk.html

Tips Sederhana Meningkatkan PageRank dengan Multi Level Marketing Backlink (MLM-B)

Habis selancar kesana-kesini tidak disangka-sangka ternyata blog jelekku dan paling berantakan sedunia yang mana lama sekali gak pernah update karena kesibukan mengejar setoran demi kelancaran dan kelangsungan "Ngebul-nya Dapur", selama ini masih bertahan di PR-4 (salah satunya bisa dilihat pada artikel sobat septian-lbs-2012) Daftar Blog Dofollow Indonesia 2012 Pagerank Tinggi dan masih banyak sobat-sobat lain yang ikut sumbangsih membantu untuk men-publish bloger sobat-sobat Do-Follow dengan PageRank tinggi.

Kali ini saya ingin berbagi tips dari sobat-sobat blogger mengenai cara cepat meningkatkan PageRank Blog ala MLM-B yaitu dengan cara penyebaran link untuk mendapatkan backlink sebanyak-banyaknya.

Buat kawan-kawan blogger yang ingin mencoba mengikuti Multi Level Backlink (MLM-B) ini, silahkan copy paste tulisan/link dibawah ini dengan mengikuti ketentuan yang telah dibuat.
Untuk tips kali ini saya mencoba mengajak kawan-kawan untuk memanfaatkan kedahsyatan faktor kali dan kecepatan penyebaran ini dalam bentuk backlink.
 

Cara awal adalah meletakkan link-link berikut ini di blog atau artikel anda :

1. subagya - PageRank 5
2. nagapasha - PageRank 5
3. harry.sufehmi - PageRank 4
4. bloggerbekasi - PageRank 4
5. redeagle21 - PageRank 4
6. mu-ri - PageRank 4
7. ot-indo - PageRank 4
8. jovieblog - PageRank 4
9. cah-cikrik - PageRank 4
10. dhuwuh - PageRank 4 (ini blog saya ya sob)

Rumus dan tata caranya : Sebelum anda meletakkan link diatas di bloger, anda harus menghapus "Peserta Nomor 1" dari daftar, sehingga semua peserta naik 1 tingkat level.
Yang tadinya :
Urutan nomor 1, sekarang sudah hilang
Urutan nomor 2, sekarang jadi nomor 1
Urutan nomor 3, sekarang jadi nomor 2
Urutan nomor 4, sekarang jadi nomor 3
Urutan nomor 5, sekarang jadi nomor 4
Urutan nomor 6, sekarang jadi nomor 5
Urutan nomor 7, sekarang jadi nomor 6
Urutan nomor 8, sekarang jadi nomor 7
Urutan nomor 9, sekarang jadi nomor 8
Urutan nomor 10, sekarang jadi nomor 9
Kemudian masukkan link kamu sendiri di bagian paling bawah (nomor 10).

Contoh buat anda yang pertama kali melihat dan melakukan tips ini :
Copy Paste Blog Link ini ke blog atau artikel anda seperti ini :

* Jika sebagai orang - 1 :
1. nagapasha - PageRank 5
2. harry.sufehmi - PageRank 4
3. bloggerbekasi - PageRank 4
4. redeagle21 - PageRank 4
5. mu-ri - PageRank 4
6. ot-indo - PageRank 4
7. jovieblog - PageRank 4
8. cah-cikrik - PageRank 4
9. dhuwuh - PageRank 4 (blog saya sekarang urutan 9)
10. isi dengan Link Blogger orang 1 (sebagai orang 1)

* Jika sebagai orang - 2 :
1. harry.sufehmi - PageRank 4
2. bloggerbekasi - PageRank 4
3. redeagle21 - PageRank 4
4. mu-ri - PageRank 4
5. ot-indo - PageRank 4
6. jovieblog - PageRank 4
7. cah-cikrik - PageRank 4
8. dhuwuh - PageRank 4 (blog saya sekarang urutan 8)
9. isi dengan Link Blogger orang 1 (sebagai orang 1)
10. isi dengan Link Blogger orang 2 (sebagai orang 2)

* Jika sebagai orang - 3 :
1. bloggerbekasi - PageRank 4
2. redeagle21 - PageRank 4
3. mu-ri - PageRank 4
4. ot-indo - PageRank 4
5. jovieblog - PageRank 4
6. cah-cikrik - PageRank 4
7. dhuwuh - PageRank 4 (blog saya sekarang urutan 7 dan seterusnya)
8. isi dengan Link Blogger orang 1 (sebagai orang 1)
9. isi dengan Link Blogger orang 2 (sebagai orang 2)
10. isi dengan Link Blogger orang 3 (sebagai orang 3)

dan seterusnya.....

Jika tata cara tsb diatas dilakukan dengan tertib dan terencana serta tiap peserta mampu mengajak 5 orang saja, maka jumlah backlink yang akan didapat adalah : Ketika.....

Posisi kamu 10, jumlah backlink yang di dapat = 1
Posisi 9, jumlah backlink yang di dapat = 5
Posisi 8, jumlah backlink yang di dapat = 25
Posisi 7, jumlah backlink yang di dapat = 125
Posisi 6, jumlah backlink yang di dapat = 625
Posisi 5, jumlah backlink yang di dapat = 3,125
Posisi 4, jumlah backlink yang di dapat = 15,625
Posisi 3, jumlah backlink yang di dapat = 78,125
Posisi 2, jumlah backlink yang di dapat = 390,625
Posisi 1, jumlah backlink yang di dapat = 1,953,125

Dan semuanya menggunakan kata kunci yang kamu inginkan.
Dari sisi SEO kita sudah mendapatkan 1,953,125 backlink dan efek sampingnya jika pengunjung web para downline kita mengklik link itu, juga membuat blog kita mendapatkan traffik tambahan.

Attention :
Ingat, anda harus mulai dari posisi 10 agar hasilnya maksimal.
Karena jika anda tiba-tiba di posisi 1, maka link kamu akan hilang begitu ada yang masuk ke posisi 10.

Namanya juga berusaha kan sob...
Apapun itu pasti kita akan mencobanya untuk mendapatkan nilai lebih, terpenting halal dan jujur...

Selamat mencoba dan selamat menunaikan Ibadah Puasa Ramadhan 1 Syawal 1433 H

Source : http://dhuwuh.blogspot.com/2012/08/tips-sederhana-meningkatkan-pagerank.html