Source Code :
Private Sub Command1_Click()
Dim Tanggal As Date
Dim JumlahTanggal As Byte
Tanggal = InputBox$("Masukkan Sebuah Tanggal", _
"Cari Jumlah Tanggal")
JumlahTanggal = CekTanggal(Tanggal)
MsgBox JumlahTanggal
End Sub
Function CekTanggal(strTanggal As Date) As Integer
Dim strTgl As String, intKabisat As Integer
Dim dd As Integer, mm As Integer, yyyy As Integer
On Error GoTo Pesan
strTgl = Format(strTanggal, "dd/mm/yyyy") 'Konversikan ke string
dd = Int(Left(strTgl, 2)) 'Ambil 2 angka pertama untuk tanggal
mm = Int(Mid(strTgl, 4, 2)) 'Ambil 2 angka di tengah untuk bulan
yyyy = Int(Right(strTgl, 4)) 'Ambil 4 angka terakhir untuk tahun
intKabisat = yyyy Mod 4 'Set variabel kabisat
'Lakukan pemeriksaan untuk memperoleh jumlah tanggal
If ((dd >= 1) And (dd <= 31)) And ((mm = 1) _
Or (mm = 3) Or (mm = 5) Or (mm = 7) Or (mm = 8) _
Or (mm = 10) Or (mm = 12)) Then
CekTanggal = 31
ElseIf ((dd >= 1) And (dd <= 30)) And ((mm = 4) _
Or (mm = 6) Or (mm = 9) Or (mm = 11)) Then
CekTanggal = 30
ElseIf ((dd >= 1) And (dd <= 28)) And (mm = 2) _
And (intKabisat <> 0) Then
CekTanggal = 28
ElseIf (dd = 29) And (mm = 2) And (intKabisat = 0) Then
CekTanggal = 29
Else
CekTanggal = 29
End If
Exit Function
Pesan:
MsgBox "Tanggal atau formatnya salah!", _
vbCritical, "Error Tanggal"
End Function
