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

visual basic

Tentang Penulis

Software developer yang fokus mengembangkan aplikasi di atas platform .NET (Desktop, ASP.NET MVC, Web Service, Microservice) dan Android. Senang mempelajari teknologi baru terutama di bidang OOP, Design Pattern, ORM, Database, Continuous Integration & Deployment dan arsitektur Microservice.
Saat ini bekerja sebagai staf IT di salah satu PTS di Yogyakarta sebagai senior software developer. Di waktu luang insya Alloh akan terus berbagi pengalaman di blog ini :)

« Mengganti posisi tombol default fungsi MsgBox Membuat paket instalasi update program menggunakan NSIS »

Comments