Daftar Fungsi Rahasia dan Penggunaannya

Sengaja judulnya saya buat heboh padahal sih cuma fungsi biasa yang sering saya gunakan dalam pengembangan aplikasi.

1. Mendapatkan nama bulan dalam bahasa indonesia

Public Function getBulanIndonesia(ByVal bulan As Integer) As String
   Select Case bulan
      Case 1: getBulanIndonesia = "Januari"
      Case 2: getBulanIndonesia = "Februari"
      Case 3: getBulanIndonesia = "Maret"
      Case 4: getBulanIndonesia = "April"
      Case 5: getBulanIndonesia = "Mei"
      Case 6: getBulanIndonesia = "Juni"
      Case 7: getBulanIndonesia = "Juli"
      Case 8: getBulanIndonesia = "Agustus"
      Case 9: getBulanIndonesia = "September"
      Case 10: getBulanIndonesia = "Oktober"
      Case 11: getBulanIndonesia = "November"
      Case 12: getBulanIndonesia = "Desember"
   End Select
End Function

Contoh :

Debug.Print getBulanIndonesia(Month(Now))

2. Mendapatkan nama hari dalam bahasa indonesia

Public Function getHariIndonesia(ByVal hari As Integer) As String
   Select Case hari
      Case 1: getHariIndonesia = "Minggu"
      Case 2: getHariIndonesia = "Senin"
      Case 3: getHariIndonesia = "Selasa"
      Case 4: getHariIndonesia = "Rabu"
      Case 5: getHariIndonesia = "Kamis"
      Case 6: getHariIndonesia = "Jum'at"
      Case Else: getHariIndonesia = "Sabtu"
   End Select
End Function

Contoh :

Debug.Print getHariIndonesia(Weekday(Now))

3. Mendapatkan jumlah hari dalam satu bulan

Public Function getJumlahHari(ByVal bulan As Integer, ByVal tahun As Long) As Integer
   getJumlahHari= Day(DateSerial(tahun, bulan + 1, 0))
End Function

Contoh :

Debug.Print getJumlahHari(Month(Now), Year(Now))

4. Mendapatkan angka dalam string

Private Function getAngka(ByVal strString As String) As String
   Dim strAngka    As String
   Dim i           As Long</pre>

   For i = 1 To Len(strString)
      If (Val(Mid(strString, i, 1)) > 0) Or (Mid(strString, i, 1) = "0") Then
         strAngka = strAngka & Mid(strString, i, 1)
      End If
   Next
   getAngka = strAngka
End Function

Contoh:

Debug.Print getAngka("coding4ever") 'output = 4

5. Validasi Input khusus angka

Public Function validasiAngka(KeyAscii As Integer) As Integer
   Dim strValid As String

   strValid = "0123456789"
   If InStr(strValid, Chr(KeyAscii)) = 0 And Not (KeyAscii = vbKeyBack) Then
      validasiAngka = 0
   Else
      validasiAngka = KeyAscii
   End If
End Function

Contoh:

Private Sub txtJumlah_KeyPress(KeyAscii As Integer)
   KeyAscii = validasiAngka(KeyAscii)
End Sub

6. Validasi input khusus huruf

Public Function validasiHuruf(KeyAscii As Integer) As Integer
   Dim strValid As String

   strValid = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
   If InStr(strValid, Chr(KeyAscii)) = 0 And Not (KeyAscii = vbKeyBack) Then
      validasiHuruf = 0
   Else
      validasiHuruf = KeyAscii
   End If
End Function

Contoh:

Private Sub txtNama_KeyPress(KeyAscii As Integer)
   KeyAscii = validasiHuruf(KeyAscii)
End Sub

7. Konversi ke huruf besar

Public Function hurufBesar(KeyAscii As Integer) As Integer
   hurufBesar = Asc(UCase(Chr(KeyAscii)))
End Function

Contoh:

Private Sub txtNama_KeyPress(KeyAscii As Integer)
   KeyAscii = hurufBesar(KeyAscii)
End Sub

8. Mengecek file ada atau tidak

Public Function fileExists(ByVal strNamaFile As String) As Boolean
   If Not (Len(strNamaFile) > 0) Then fileExists = False: Exit Function
   If Dir$(strNamaFile, vbNormal) = "" Then
      fileExists = False
   Else
      fileExists = True
   End If
End Function

Contoh:

Debug.Print fileExists("c:\text.txt")

9. Mengecek direktori/folder ada atau tidak

Public Function dirExists(ByVal strNamaFile As String) As Boolean
   If Not (Len(strNamaFile) > 0) Then dirExists = False: Exit Function
   If Dir$(strNamaFile, vbDirectory) = "" Then
      dirExists = False
   Else
      dirExists = True
   End If
End Function

Contoh:

Debug.Print dirExists("c:\windows")

10. Anti tanda ‘ tunggal

Karakter tanda ‘ dalam kasus-kasus tertentu bisa menyebabkan bug/error pada program. Misalkan pada saat pemanggilan perintah INSERT atau UPDATE pada pemrograman database.

Lihat kode berikut:

Private Sub cmdUpdateNama_Click()
   Dim nama    As String

   nama = "Ja'far"
   conn.Execute "UPDATE siswa SET nama = '" & nama & "' WHERE nis = '1234'" 'error karena ada tanda petik di var nama
End Sub

cara termudah untuk menghandle kasus diatas cukup dengan menambahkan fungsi berikut :

Public Function rep(ByVal Kata As String) As String
   rep = Replace(Kata, "'", "''")
End Function

kemudian melakukan sedikit revisi kode :

Private Sub cmdUpdateNama_Click()
   Dim nama    As String

   nama = "Ja'far"
   conn.Execute "UPDATE siswa SET nama = '" & rep(nama) & "' WHERE nis = '1234'" 'sudah tidak error lagi
End Sub

11. Mendapatkan selisih hari dalam 2 tanggal

Public Function getSelisihHari(ByVal tglMulai As String, ByVal tglSelesai As String) As Long
   getSelisihHari = DateTime.DateDiff("d", tglMulai, tglSelesai)
End Function

Contoh:

   Debug.Print getSelisihHari("2009/12/1", "2009/12/5") 'output = 4

12. Huruf Pertama Besar

Public Function firstUCase(ByVal value As String) As String
    firstUCase = UCase(Mid$(value, 1, 1)) & Mid(value, 2)
End Function

Contoh:

   Debug.Print firstUCase("hello world") 'output = Hello world

Selamat mencoba