Senin, 10 Oktober 2016

Kode Script



‘****** Mulai - copy dari sini ********
Public Function angkaterbilang(x As Currency)
' semua kalimat dibelakang tanda ' ini tidak akan dibaca(hanya komentar).
' Hi... my name is SINGGIH_PY, I made this software in the iddle time and just for fun.
' If you can see this line, suppose you are a Hacker, unfortunately I hate hacker.
' This software was protected by the Law, prohibited will be shoot at down. Oh no, I just kiddy he he he
' All moslem is brother, so you are my brother or my sister, you may use this software for free, as long as possible
' and many as manytime even until your fingger become curly, he he he.
' Anda suka program ini? kunjungi " https://PengetikCepat.blogspot.com " dan download versi terbarunya. Terimakasih.
Dim triliun As Currency
Dim milyar As Currency
Dim juta As Currency
Dim ribu As Currency
Dim satu As Currency
Dim sen As Currency
Dim baca As String
If x = 0 Then
   baca = angka(0, 1)
Else
   triliun = Int(x * 0.001 ^ 4)
   milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
   juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
   ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
   satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
   sen = Int((x - Int(x)) * 100)
   If triliun > 0 Then
      baca = ratus(triliun, 5) + "triliun "
   End If
   If milyar > 0 Then
      baca = baca + ratus(milyar, 4) + "milyar "
   End If
   If juta > 0 Then
      baca = baca + ratus(juta, 3) + "juta "
   End If
   If ribu > 0 Then
      baca = baca + ratus(ribu, 2) + "ribu "
   End If
   If satu > 0 Then
      baca = baca + ratus(satu, 1) + "rupiah "
   Else
      baca = baca + "rupiah "
   End If
   If sen > 0 Then
      baca = baca + ratus(sen, 0) + "sen"
   End If
End If
angkaterbilang = LCase(Left(baca, 1)) & LCase(Mid(baca, 2))
End Function

Function ratus(x As Currency, posisi As Integer) As String
Dim a100 As Integer, a10 As Integer, a1 As Integer
Dim baca As String
a100 = Int(x * 0.01)
a10 = Int((x - a100 * 100) * 0.1)
a1 = Int(x - a100 * 100 - a10 * 10)
If a100 = 1 Then
   baca = "Seratus "
Else
   If a100 > 0 Then
      baca = angka(a100, 2) + "ratus "
   End If
End If
If a10 = 1 Then
   baca = baca + angka(a10 * 10 + a1, 2)
Else
   If a10 > 0 Then
      baca = baca + angka(a10, 2) + "puluh "
   End If
   If a1 > 0 Then
      If posisi = 2 And a100 = 0 And a10 = 0 Then
         baca = baca + angka(a1, 1)
      Else
         baca = baca + angka(a1, 2)
      End If
   End If
End If
ratus = baca
End Function

Function angka(x As Integer, posisi As Integer)
Select Case x
       Case 0: angka = "nol"
       Case 1:
               If posisi = 2 Then
                  angka = "satu "
               Else
                  angka = "se"
               End If
       Case 2: angka = "dua "
       Case 3: angka = "tiga "
       Case 4: angka = "empat "
       Case 5: angka = "lima "
       Case 6: angka = "enam "
       Case 7: angka = "tujuh "
       Case 8: angka = "delapan "
       Case 9: angka = "sembilan "
       Case 10: angka = "sepuluh "
       Case 11: angka = "sebelas "
       Case 12: angka = "dua belas "
       Case 13: angka = "tiga belas "
       Case 14: angka = "empat belas "
       Case 15: angka = "lima belas "
       Case 16: angka = "enam belas "
       Case 17: angka = "tujuh belas "
       Case 18: angka = "delapan belas "
       Case 19: angka = "sembilan belas "
End Select
End Function
Function chari(hari As Currency)
Select Case hari
       Case 1: chari = "Minggu "
       Case 2: chari = "Senin "
       Case 3: chari = "Selasa "
       Case 4: chari = "Rabu "
       Case 5: chari = "Kamis "
       Case 6: chari = "Jumat "
       Case 7: chari = "Sabtu "
End Select
End Function
Function cbln(bulan As Currency)
Select Case bulan
       Case 1: cbln = "Januari "
       Case 2: cbln = "Februari "
       Case 3: cbln = "Maret "
       Case 4: cbln = "April "
       Case 5: cbln = "Mei "
       Case 6: cbln = "Juni "
       Case 7: cbln = "Juli "
       Case 8: cbln = "Agustus "
       Case 9: cbln = "September "
       Case 10: cbln = "Oktober "
       Case 11: cbln = "November "
       Case 12: cbln = "Desember "
End Select
End Function


Public Function hariterbilang(tanggal)
Dim tgl As Currency
Dim bln As Currency
Dim thn As Currency
Dim hari As Currency
Dim MyDate
MyDate = Date
tgl = Val(Day(tanggal))
bln = Month(tanggal)
thn = Year(tanggal)
ctgl = angkaterbilang(tgl)
cthn = angkaterbilang(thn)
hari = Weekday(tanggal)
    hariterbilang = chari(hari)
End Function
Public Function tanggalterbilang(tanggal)
Dim tgl As Currency
Dim bln As Currency
Dim thn As Currency
Dim hari As Currency
Dim MyDate
MyDate = Date
tgl = Val(Day(tanggal))
bln = Month(tanggal)
thn = Year(tanggal)
ctgl = angkaterbilang(tgl)
cthn = angkaterbilang(thn)
hari = Weekday(tanggal)
    tanggalterbilang = Left(ctgl, Len(ctgl) - 7) & cbln(bln) & Left(cthn, Len(cthn) - 7)
End Function
Public Function tanggal(x As Currency)
Dim triliun As Currency
Dim milyar As Currency
Dim juta As Currency
Dim ribu As Currency
Dim satu As Currency
Dim sen As Currency
Dim baca As String
If x = 0 Then
   baca = angka(0, 1)
Else
   triliun = Int(x * 0.001 ^ 4)
   milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
   juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
   ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
   satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
   sen = Int((x - Int(x)) * 100)
   If triliun > 0 Then
      baca = ratus(triliun, 5) + "triliun "
   End If
   If milyar > 0 Then
      baca = baca + ratus(milyar, 4) + "milyar "
   End If
   If juta > 0 Then
      baca = baca + ratus(juta, 3) + "juta "
   End If
   If ribu > 0 Then
      baca = baca + ratus(ribu, 2) + "ribu "
   End If
   If satu > 0 Then
      baca = baca + ratus(satu, 1) + "rupiah "
   Else
      baca = baca + "rupiah "
   End If
   If sen > 0 Then
      baca = baca + ratus(sen, 0) + "sen"
   End If
End If
tanggal = LCase(Left(baca, 1)) & LCase(Mid(baca, 2))
End Function

Public Function jamterbilang(jam)
Dim tjam As Currency
Dim tmenit As Currency
Dim MyDate
MyDate = Date
tjam = Left(jam, 2)
tmenit = Right(jam, 2)
cjam = jmterbilang(tjam)
Cmenit = jmterbilang(tmenit)
    If tmenit = 0 Then
       jamterbilang = cjam & "tepat"
    Else
       jamterbilang = cjam & "lewat " & Cmenit & "menit"
    End If
End Function

Public Function jam(x As Currency)
Dim triliun As Currency
Dim milyar As Currency
Dim juta As Currency
Dim ribu As Currency
Dim satu As Currency
Dim sen As Currency
Dim baca As String
If x = 0 Then
   baca = angka(0, 1)
Else
   triliun = Int(x * 0.001 ^ 4)
   milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
   juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
   ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
   satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
   sen = Int((x - Int(x)) * 100)
   If triliun > 0 Then
      baca = ratus(triliun, 5) + "triliun "
   End If
   If milyar > 0 Then
      baca = baca + ratus(milyar, 4) + "milyar "
   End If
   If juta > 0 Then
      baca = baca + ratus(juta, 3) + "juta "
   End If
   If ribu > 0 Then
      baca = baca + ratus(ribu, 2) + "ribu "
   End If
   If satu > 0 Then
      baca = baca + ratus(satu, 1)
   Else
      baca = baca
   End If
   If sen > 0 Then
      'baca = baca + ratus(sen, 0) + "sen"
   End If
End If
jam = LCase(Left(baca, 1)) & LCase(Mid(baca, 2))
End Function

Public Function jmterbilang(x As Currency)
Dim triliun As Currency
Dim milyar As Currency
Dim juta As Currency
Dim ribu As Currency
Dim satu As Currency
Dim sen As Currency
Dim baca As String
If x = 0 Then
   baca = angka(0, 1)
Else
   triliun = Int(x * 0.001 ^ 4)
   milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
   juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
   ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
   satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
   sen = Int((x - Int(x)) * 100)
   If triliun > 0 Then
      baca = ratus(triliun, 5) + "triliun "
   End If
   If milyar > 0 Then
      baca = baca + ratus(milyar, 4) + "milyar "
   End If
   If juta > 0 Then
      baca = baca + ratus(juta, 3) + "juta "
   End If
   If ribu > 0 Then
      baca = baca + ratus(ribu, 2) + "ribu "
   End If
   If satu > 0 Then
      baca = baca + ratus(satu, 1)
   Else
      baca = baca
   End If
   If sen > 0 Then
      baca = baca + ratus(sen, 0) + "sen"
   End If
End If
jmterbilang = LCase(Left(baca, 1)) & LCase(Mid(baca, 2))
End Function

Public Function xtnn(sx As String)
Dim baca As String
Dim iLength As Integer
Dim MyDate
MyDate = Date
If sx = "" Then
   baca = ""
Else
   iLength = Len(sx)
   If Left(sx, 5) = "Tuan " Then
      baca = Right(sx, iLength - 5)
   End If
   If Left(sx, 5) = "Nona " Then
      baca = Right(sx, iLength - 5)
   End If
   If Left(sx, 7) = "Nyonya " Then
      baca = Right(sx, iLength - 7)
   End If
End If
    xtnn = baca
End Function

Public Function ddMMyyyy(tanggal)
Dim tgl As Currency
Dim bln As Currency
Dim thn As Currency
Dim hari As Currency
Dim stgl As String
Dim MyDate
MyDate = Date
tgl = Val(Day(tanggal))
bln = Month(tanggal)
thn = Year(tanggal)
ctgl = angkaterbilang(tgl)
stgl = "00"
cthn = angkaterbilang(thn)
hari = Weekday(tanggal)
    Select Case tgl
      Case 1: stgl = "01 "
      Case 2: stgl = "02 "
      Case 3: stgl = "03 "
      Case 4: stgl = "04 "
      Case 5: stgl = "05 "
      Case 6: stgl = "06 "
      Case 7: stgl = "07 "
      Case 8: stgl = "08 "
      Case 9: stgl = "09 "
      Case 10: stgl = "10 "
      Case 11: stgl = "11 "
      Case 12: stgl = "12 "
      Case 13: stgl = "13 "
      Case 14: stgl = "14 "
      Case 15: stgl = "15 "
      Case 16: stgl = "16 "
      Case 17: stgl = "17 "
      Case 18: stgl = "18 "
      Case 19: stgl = "19 "
      Case 20: stgl = "20 "
      Case 21: stgl = "21 "
      Case 22: stgl = "22 "
      Case 23: stgl = "23 "
      Case 24: stgl = "24 "
      Case 25: stgl = "25 "
      Case 26: stgl = "26 "
      Case 27: stgl = "27 "
      Case 28: stgl = "28 "
      Case 29: stgl = "29 "
      Case 30: stgl = "30 "
      Case 31: stgl = "31 "
    End Select
    ddMMyyyy = stgl & cbln(bln) & thn
End Function

Public Function jaminterval(sx As String, x As Integer)
Dim tjam As Currency
Dim tmenit As Currency
tjam = Left(sx, 2)
tmenit = Right(sx, 2)
imenit = tmenit + x
If imenit < 60 Then
  'cjam = tjam
  'Cmenit = imenit
Else
  If tjam < 24 Then
    tjam = tjam + 1
  Else
    tjam = 1
    'cjam = tjam
  End If
  imenit = 0
End If
Select Case tjam
  Case 1: sjam = "01"
  Case 2: sjam = "02"
  Case 3: sjam = "03"
  Case 4: sjam = "04"
  Case 5: sjam = "05"
  Case 6: sjam = "06"
  Case 7: sjam = "07"
  Case 8: sjam = "08"
  Case 9: sjam = "09"
  Case 10: sjam = "10"
  Case 11: sjam = "11"
  Case 12: sjam = "12"
  Case 13: sjam = "13"
  Case 14: sjam = "14"
  Case 15: sjam = "15"
  Case 16: sjam = "16"
  Case 17: sjam = "17"
  Case 18: sjam = "18"
  Case 19: sjam = "19"
  Case 20: sjam = "20"
  Case 21: sjam = "21"
  Case 22: sjam = "22"
  Case 23: sjam = "23"
  Case 24: sjam = "24"
End Select
Select Case imenit
  Case 0: smenit = "00"
  Case 1: smenit = "01"
  Case 2: smenit = "02"
  Case 3: smenit = "03"
  Case 4: smenit = "04"
  Case 5: smenit = "05"
  Case 6: smenit = "06"
  Case 7: smenit = "07"
  Case 8: smenit = "08"
  Case 9: smenit = "09"
  Case 10: smenit = "10"
  Case 11: smenit = "11"
  Case 12: smenit = "12"
  Case 13: smenit = "13"
  Case 14: smenit = "14"
  Case 15: smenit = "15"
  Case 16: smenit = "16"
  Case 17: smenit = "17"
  Case 18: smenit = "18"
  Case 19: smenit = "19"
  Case 20: smenit = "20"
  Case 21: smenit = "21"
  Case 22: smenit = "22"
  Case 23: smenit = "23"
  Case 24: smenit = "24"
  Case 25: smenit = "25"
  Case 26: smenit = "26"
  Case 27: smenit = "27"
  Case 28: smenit = "28"
  Case 29: smenit = "29"
  Case 30: smenit = "30"
  Case 31: smenit = "31"
  Case 32: smenit = "32"
  Case 33: smenit = "33"
  Case 34: smenit = "34"
  Case 35: smenit = "35"
  Case 36: smenit = "36"
  Case 37: smenit = "37"
  Case 38: smenit = "38"
  Case 39: smenit = "39"
  Case 40: smenit = "40"
  Case 41: smenit = "41"
  Case 42: smenit = "42"
  Case 43: smenit = "43"
  Case 44: smenit = "44"
  Case 45: smenit = "45"
  Case 46: smenit = "46"
  Case 47: smenit = "47"
  Case 48: smenit = "48"
  Case 49: smenit = "49"
  Case 50: smenit = "50"
  Case 51: smenit = "51"
  Case 52: smenit = "52"
  Case 53: smenit = "53"
  Case 54: smenit = "54"
  Case 55: smenit = "55"
  Case 56: smenit = "56"
  Case 57: smenit = "57"
  Case 58: smenit = "58"
  Case 59: smenit = "59"
End Select
jaminterval = sjam & "." & smenit
End Function

Public Function inc2dgt(sx As String)
Dim iLength As Integer
Dim baca As String
Dim tmenit As Currency
tmenit = Right(sx, 2)
imenit = tmenit + 1
Select Case imenit
  Case 0: smenit = "00"
  Case 1: smenit = "01"
  Case 2: smenit = "02"
  Case 3: smenit = "03"
  Case 4: smenit = "04"
  Case 5: smenit = "05"
  Case 6: smenit = "06"
  Case 7: smenit = "07"
  Case 8: smenit = "08"
  Case 9: smenit = "09"
  Case 10: smenit = "10"
  Case 11: smenit = "11"
  Case 12: smenit = "12"
  Case 13: smenit = "13"
  Case 14: smenit = "14"
  Case 15: smenit = "15"
  Case 16: smenit = "16"
  Case 17: smenit = "17"
  Case 18: smenit = "18"
  Case 19: smenit = "19"
  Case 20: smenit = "20"
  Case 21: smenit = "21"
  Case 22: smenit = "22"
  Case 23: smenit = "23"
  Case 24: smenit = "24"
  Case 25: smenit = "25"
  Case 26: smenit = "26"
  Case 27: smenit = "27"
  Case 28: smenit = "28"
  Case 29: smenit = "29"
  Case 30: smenit = "30"
  Case 31: smenit = "31"
  Case 32: smenit = "32"
  Case 33: smenit = "33"
  Case 34: smenit = "34"
  Case 35: smenit = "35"
  Case 36: smenit = "36"
  Case 37: smenit = "37"
  Case 38: smenit = "38"
  Case 39: smenit = "39"
  Case 40: smenit = "40"
  Case 41: smenit = "41"
  Case 42: smenit = "42"
  Case 43: smenit = "43"
  Case 44: smenit = "44"
  Case 45: smenit = "45"
  Case 46: smenit = "46"
  Case 47: smenit = "47"
  Case 48: smenit = "48"
  Case 49: smenit = "49"
  Case 50: smenit = "50"
  Case 51: smenit = "51"
  Case 52: smenit = "52"
  Case 53: smenit = "53"
  Case 54: smenit = "54"
  Case 55: smenit = "55"
  Case 56: smenit = "56"
  Case 57: smenit = "57"
  Case 58: smenit = "58"
  Case 59: smenit = "59"
  Case 60: smenit = "60"
  Case 61: smenit = "61"
  Case 62: smenit = "62"
  Case 63: smenit = "63"
  Case 64: smenit = "64"
  Case 65: smenit = "65"
  Case 66: smenit = "66"
  Case 67: smenit = "67"
  Case 68: smenit = "68"
  Case 69: smenit = "69"
  Case 70: smenit = "70"
  Case 71: smenit = "71"
  Case 72: smenit = "72"
  Case 73: smenit = "73"
  Case 74: smenit = "74"
  Case 75: smenit = "75"
  Case 76: smenit = "76"
  Case 77: smenit = "77"
  Case 78: smenit = "78"
  Case 79: smenit = "79"
  Case 80: smenit = "80"
  Case 81: smenit = "81"
  Case 82: smenit = "82"
  Case 83: smenit = "83"
  Case 84: smenit = "84"
  Case 85: smenit = "85"
  Case 86: smenit = "86"
  Case 87: smenit = "87"
  Case 88: smenit = "88"
  Case 89: smenit = "89"
  Case 90: smenit = "90"
  Case 91: smenit = "91"
  Case 92: smenit = "92"
  Case 93: smenit = "93"
  Case 94: smenit = "94"
  Case 95: smenit = "95"
  Case 96: smenit = "96"
  Case 97: smenit = "97"
  Case 98: smenit = "98"
  Case 99: smenit = "99"
End Select
If sx = "" Then
   baca = ""
Else
  iLength = Len(sx)
  baca = Left(sx, iLength - 2)
End If
inc2dgt = baca & smenit
End Function
‘****** Akhir – copy sampai sini ********
Panjang ya? Fyuh cape ngetiknya, tapi kalau copy paste lain kayaknya he he he.
Cara copy paste ini paling sip, karena dijamin bebas virus, seperti kita ketahui file.xla dibuat dengan bahasa pemrograman yang rentan dengan serangan virus.

Tidak ada komentar:

Posting Komentar

Boleh memberikan saran/kritik/komentar