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
