Private Sub Command1_Click()
MsgBox Dias_del_Año(2006) & " días"
End Sub
Private Sub Command2_Click()
MsgBox Dias_Del_Mes("05/09/2006") & " días"End Sub
Private Sub Command3_Click()
MsgBox es_Fin_de_Semana(Date)
End Sub
Private Sub Command4_Click()
MsgBox fin_del_Mes(Date)
End Sub
Private Sub Command5_Click()
MsgBox fin_de_Semana(Date)
End Sub
Private Sub Form_Load()
Command1.Caption = " Cantidad de Dias de un Año "
Command2.Caption = " Cantidad de Días de un Mes "
Command3.Caption = " Fin de semana ? "
Command4.Caption = " Obtener último día de un Mes "
Command5.Caption = " Obtener último día de una semana "
End Sub
'Funciones
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Calcula la cantidad de días de un año
Public Function Dias_del_Año(ByVal valor As Variant) As Integer
If IsDate(valor) Or _
IsNumeric(valor) Then
Dias_del_Año = IIf(saltarYear(valor), 366, 365)
End If
End Function
Public Function saltarYear(ByVal valor As Variant) As Boolean
On Error GoTo LocalError
Dim iYear As Integer
If IsDate(valor) Then iYear = Year(valor) Else iYear = CInt(valor)
If TypeName(iYear) = "Integer" Then
saltarYear = Day(DateSerial(iYear, 3, 0)) = 29
End If
Exit Function
LocalError:
End Function
'Calcula la cantidad de días de un mes de una fecha determinada
'La fecha debe tener el formato mm/dd/yyyy
'Si no se pasa el parámetro se asume la fecha de hoy
Public Function Dias_Del_Mes(Optional ByVal Fecha As Variant) As Integer
Dim mes As Integer, y As Integer
If IsMissing(Fecha) Then Fecha = Date
If IsDate(Fecha) Then
y = Year(Fecha)
mes = Month(Fecha)
ElseIf IsNumeric(Fecha) Then
y = Year(Date)
mes = IIf(Fecha > 0 And Fecha < 13, CInt(Fecha), 0)
ElseIf VarType(Fecha) = vbString Then
y = Year(Date)
Select Case UCase(Left$(Fecha, 3))
Case "FEB": mes = 2
Case "JAN", "MAR", "MAY", "JUL", "AUG", "OCT", "DEC": mes = 1
Case "APR", "JUN", "SEP", "NOV": mes = 4
End Select
End If
Select Case mes
Case 2: Dias_Del_Mes = IIf(saltarYear(Fecha), 29, 28)
Case 1, 3, 5, 7, 8, 10, 12: Dias_Del_Mes = 31
Case 4, 6, 9, 11: Dias_Del_Mes = 30
End Select
End Function
'Devuelve si un determinado día corresponde a un fin de semana
Public Function es_Fin_de_Semana(ByVal Fecha As Variant) As Boolean
If IsDate(Fecha) Then
If (Weekday(Fecha) = 1) Or (Weekday(Fecha) = 7) Then
es_Fin_de_Semana = True
End If
End If
End Function
'Devuelve el último días del Mes
Public Function fin_del_Mes(Fecha As Variant) As Date
If IsDate(Fecha) Then
fin_del_Mes = DateAdd("m", 1, Fecha) fin_del_Mes = DateSerial(Year(fin_del_Mes), Month(fin_del_Mes), 1)
fin_del_Mes = DateAdd("d", -1, fin_del_Mes) End If
End Function
'Devuelve el último día de la semana
Function fin_de_Semana(ByVal Fecha As Date) As Date
If IsDate(Fecha) Then
fin_de_Semana = FormatDateTime(Fecha - Weekday(Fecha) + 7, vbGeneralDate)
End If
End Function
