Mencakar Langit: Membuat Link WoorkSheet Excel ke Word Dengan VBA

Mencakar Langit: Membuat Link WoorkSheet Excel ke Word Dengan VBA

FILSUF SEBUAH BOTOL

*FILSUF Sebuah BOTOL* 🍶
~Kalau diisi air mineral, harganya 3 ribuan...
~Kalau diisi jus buah, harganya 10 ribuan...
~Kalau diisi Madu, harganya ratusan ribu...
~Kalau diisi minyak wangi harganya bisa jutaan!.
~Kalau diisi air comberan, hanya akan dibuang dalam tong sampah karena tidak ada harganya...
*Sama-sama dikemas dalam BOTOL tetapi berbeda nilainya, sebab "isi" yang ada di dalamnya berbeda...*
Begitu juga dgn kita; semua sama... semua manusia...
Yang membedakannya adalah; *KARAKTER* yg ada didalam diri kita.
Ilmu dan pemahaman yg benar akan membangun karakter yg benar.
*"Sukses tidak diukur dari posisi yg kita capai, tapi dari kesulitan'2 yg berhasil kita atasi ketika berusaha meraih sukses"*
Bila kita mengisi hati, dgn penyesalan masa lalu & kekhawatiran akan masa depan, hampir pasti kita tidak akan memiliki hari ini untuk kita syukuri.
_Hujan & badai akan selalu kita temui dalam perjalanan hidup, namun..._
*"Hujan besar itu seperti tantangan hidup. Tidak perlu berdoa memohon hujan berhenti, tetapi cukup berdoa agar Payung kita bertambah kuat"*
*Ingat! Umur itu seperti es batu.*
_*dipakai atau tidak dipakai akan tetap mencair... digunakan atau tidak digunakan umur kita tetap akan berkurang dari "jatah" yg telah ditetapkan._
*"Selagi masih tersisa jatah usia kita, lakukanlah KEBAIKAN sebanyak yg kita mampu lakukan."

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

DOWNLOAD CONTOH FILE

Semoga Bermanfaat.

Cara Mengetahui Kelamin Komputer

NOV

11

Cara Mengetahui Kelamin Komputer

Abstrak

Lagi jalan-jalan gak sengaja saya menemukan tips cara mengetahui kelamin komputer

ini, pasti anda semua bingung apa benar komputer memiliki kelamin?

Kata Kunci:kelamin,komputer

Pendahuluan

Mari kita buktikan apa jenis kelamin komputer atau laptop anda.

Pembahasan

Langkah-langkah yang harus dilakukan :

1. Dengan tampilan dekstop, Buka Notepad.

2. Isi dengan kode ini CreateObject("SAPI.SpVoice").Speak"I Love You".

3. Save file tersebut dengan nama apa saja bebas terserah anda, Contoh : xyz.vbs

4. Klik dua kali file yang tadi dibuat (Pastikan volume speaker keras).

5. Jika file tersebut jalan atau berfungsi, maka terdengar seseorang menyapa.

6. Jika yang menyapa suara wanita maka komputer anda berjenis kelamin

perempuan dan begitu juga sebaliknya.

Penutup

Bagaimana, penasaran? Silahkan anda coba dan buktikan apa jenis kelamin komputer

anda. Jika sudah terbukti jangan lupa komen ya.. :-P

DOWNLOAD CONTOH FILE

excel vba create directory locate

E-Monev TEPRA Kab. Simeulue

300 Rumus Excel: Contoh Coding Simpan Data ke Database dengan VBA

300 Rumus Excel: Contoh Coding Simpan Data ke Database dengan VBA