Get the last date of the month
Sumber
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
Sumber