Coding4ever’s Blog

Just coding… coding… and coding… because coding should be fun :)

Daftar Fungsi Rahasia Dan Penggunaannya

| Comments

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

1. Mendapatkan nama bulan dalam bahasa indonesia

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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 :

1
Debug.Print getBulanIndonesia(Month(Now))

2. Mendapatkan nama hari dalam bahasa indonesia

1
2
3
4
5
6
7
8
9
10
11
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 :

1
Debug.Print getHariIndonesia(Weekday(Now))

3. Mendapatkan jumlah hari dalam satu bulan

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

Contoh :

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

4. Mendapatkan angka dalam string

1
2
3
4
5
6
7
8
9
10
11
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:

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

5. Validasi Input khusus angka

1
2
3
4
5
6
7
8
9
10
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:

1
2
3
Private Sub txtJumlah_KeyPress(KeyAscii As Integer)
   KeyAscii = validasiAngka(KeyAscii)
End Sub

6. Validasi input khusus huruf

1
2
3
4
5
6
7
8
9
10
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:

1
2
3
Private Sub txtNama_KeyPress(KeyAscii As Integer)
   KeyAscii = validasiHuruf(KeyAscii)
End Sub

7. Konversi ke huruf besar

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

Contoh:

1
2
3
Private Sub txtNama_KeyPress(KeyAscii As Integer)
   KeyAscii = hurufBesar(KeyAscii)
End Sub

8. Mengecek file ada atau tidak

1
2
3
4
5
6
7
8
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:

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

9. Mengecek direktori/folder ada atau tidak

1
2
3
4
5
6
7
8
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:

1
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:

1
2
3
4
5
6
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 :

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

kemudian melakukan sedikit revisi kode :

1
2
3
4
5
6
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

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

Contoh:

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

12. Huruf Pertama Besar

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

Contoh:

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

Selamat mencoba :)

Comments