5 funciones de fechas

Gracias a este truco de visual basic 6.0 podrás:

Saber la cantidad de días de un año determinado
Calcular la cantidad de días de un mes específico
Averiguar si un día corresponde a un fin de semana
Averiguar el último día de un Mes determinado
Averiguar el último día de una semana
 

Agregar para el ejemplo 5 CommandButton: Command1, Command2, Command3, Command4 y Command5
 

Código en un form

Private Sub Command1_Click()
MsgBox DiasDelAño(2006) & " días"
End Sub

Private Sub Command2_Click()
MsgBox DiasDelMes("05/09/2006") & " días"
End Sub

Private Sub Command3_Click()
MsgBox esFinSemana(Date)
End Sub

Private Sub Command4_Click()
MsgBox FinDelMes(Date)
End Sub

Private Sub Command5_Click()
MsgBox FinDeSemana(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 DiasDelAño(ByVal valor As Variant) As Integer
    If IsDate(valor) Or IsNumeric(valor) Then DiasDelAño = IIf(saltarYear(valor), 366, 365)
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 DiasDelMes(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:                     DiasDelMes = IIf(saltarYear(Fecha), 29, 28)
        Case 1, 3, 5, 7, 8, 10, 12: DiasDelMes = 31
        Case 4, 6, 9, 11:           DiasDelMes = 30
    End Select

End Function

'Devuelve si un determinado día corresponde a un fin de semana
Public Function esFinSemana(ByVal Fecha As Variant) As Boolean

    If IsDate(Fecha) Then
       If (Weekday(Fecha) = 1) Or (Weekday(Fecha) = 7) Then
          esFinSemana = True
       End If
    End If
End Function

'Devuelve el último días del Mes
Public Function FinDelMes(Fecha As Variant) As Date

    If IsDate(Fecha) Then
        FinDelMes = DateAdd("m", 1, Fecha)
        FinDelMes = DateSerial(Year(FinDelMes), Month(FinDelMes), 1)
        FinDelMes = DateAdd("d", -1, FinDelMes)
    End If

End Function

'Devuelve el último día de la semana

Function FinDeSemana(ByVal Fecha As Date) As Date

    If IsDate(Fecha) Then
        FinDeSemana = FormatDateTime(Fecha - Weekday(Fecha) + 7, vbGeneralDate)
    End If

End Function