jueves, 26 de noviembre de 2009

Calculo Exacto de Edad

Bueno este es mi primer aporte y aunque la verdad no parece muy significativo ya que este tipo de funciones se encuentra por doquier, si me tope con muchos problemas porque aparentemente al realizar una simple funcion haciendo uso de datediff u otros calculos en algunas fechas el resultado no era el apropiado esto por la cuestion de los años bisiestos y otros, bueno entonces probando y investigando pude concluir y llegar a una funcion que por el momento ha funcionado y no ha tenido los problemas de calculo que tuve, tengo que aclarar que no es totalmente autoria mia pero si cambie algunas cosas y agregue otras que permitian hacer un calculo exacto, sin mas preambulos aqui esta la funcion:

''' 
    ''' Retorna la cantidad de años deacuerdo a la fecha de nacimiento
    ''' 
    ''' 
    Public Shared Function calcularEdad(ByVal fechaNacimiento As Object, Optional ByRef mesesCumplidos As Integer = 0) As Integer

        Dim añosCumplidos As Integer = 0
        Dim fechaActual As New Date(Date.Now.Year, Date.Now.Month, Date.Now.Day)

        Try

            If Not IsDBNull(fechaNacimiento) Then

                If IsDate(fechaNacimiento) Then

                    If DateAndTime.DateDiff(DateInterval.Day, fechaNacimiento, fechaActual, Microsoft.VisualBasic.FirstDayOfWeek.Monday) > 0 Then
                        Dim valorDecimal As Decimal = 0
                        valorDecimal = DateDiff(DateInterval.Month, fechaNacimiento, Now, FirstDayOfWeek.Monday) / 12
                        añosCumplidos = Decimal.Truncate(valorDecimal)
                        valorDecimal = (valorDecimal - añosCumplidos) * 12
                        mesesCumplidos = Decimal.Truncate(valorDecimal)

                        If Month(fechaNacimiento) = Now.Month Then
                            If Day(fechaNacimiento) > Now.Day Then
                                añosCumplidos -= 1
                            End If
                        End If

                        If añosCumplidos < 0 Then
                            añosCumplidos = 0
                        End If

                    End If

                End If

            End If

        Catch ex As Exception

            añosCumplidos = 0
            Exit Try
        End Try

        Return añosCumplidos

    End Function
Bueno a continuacion la pagina con la cual fusione mi codigo para conseguir lo que explique url: Aqui dada por J.M Movilla