Ir para conteúdo
Fórum Script Brasil
  • 0

Calculo Idade


rodrigo maximo

Pergunta

5 respostass a esta questão

Posts Recomendados

  • 0

Caro amigo!

Tenho uma função que exibe a idade no formato A/M/D

Talvez goste... Seque codigo Abaixo...

Para utilizar o Codigo, coloque-o num Modulo

Função DMA Sem Bug

Public Enum TipoRet
 RetAno = 0
 RetDMA = 1
End Enum

Public Function UltimoDiaMes(Data As String) As String
 Dim Mes As String
 If Data = "" Then
   Exit Function
 End If

 Mes = Month(Data)
 Select Case Val(Mes)
   Case 1
     UltimoDiaMes = "31"
   Case 2
     If Val(Year(Data)) Mod 4 = 0 Then
       UltimoDiaMes = "29"
     Else
       UltimoDiaMes = "28"
     End If
   Case 3
     UltimoDiaMes = "31"
   Case 4
     UltimoDiaMes = "30"
   Case 5
     UltimoDiaMes = "31"
   Case 6
     UltimoDiaMes = "30"
   Case 7
     UltimoDiaMes = "31"
   Case 8
     UltimoDiaMes = "31"
   Case 9
     UltimoDiaMes = "30"
   Case 10
     UltimoDiaMes = "31"
   Case 11
     UltimoDiaMes = "30"
   Case 12
     UltimoDiaMes = "31"
 End Select
End Function


Public Function DMA(DataNasc As String, DataRef As String, Optional
Ret As TipoRet = 0, Optional Bissexto As Boolean = True) As String
 Dim Ano As String, Mes As String, Dia As String
 Dim Resto As String


 If Bissexto = True Then
   If DataNasc = "" Or DataRef = "" Then
     DMA = "#Erro#"
     Exit Function
   Else
     Debug.Print DateDiff("d", DataNasc, DataRef)
     Ano = Int(DateDiff("d", DataNasc, DataRef) / 365)
     Resto = (DateDiff("d", DataNasc, DataRef) / 365) - Ano
     If Resto = 0 Then
       Mes = "0"
       Dia = "0"
     Else
       Mes = Int((Resto * 365) / 30)
       Resto = ((Resto * 365) / 30) - Mes
       If Resto = 0 Then
         Dia = 0
       Else
         Dia = Round((Resto * 30), 2)
       End If
     End If
   End If
 Else
   Dim Di, Mi, Ai
   Dim Df, Mf, Af
   Dim Dr, Mr, Ar

   Di = Left(DataNasc, 2)
   Mi = Mid(DataNasc, 4, 2)
   Ai = Right(DataNasc, 4)

   Df = Left(DataRef, 2)
   Mf = Mid(DataRef, 4, 2)
   Af = Right(DataRef, 4)

   If Di > 30 Then
     Di = "30"
   End If

   If Df > 30 Then
     Df = "30"
   End If

   If Mf < Mi Then
     If Df < Di Then
       Dr = 30 - (Di - Df)    '***
       Mr = (12 - (Mi - Mf)) - 1 '***
       Ar = (Af - Ai) - 1    '***
     ElseIf Df = Di Then
       Dr = 0              '***
       Mr = (12 - (Mi - Mf)) '***
       Ar = (Af - Ai) - 1  '***
     Else
       Dr = (Df - Di)
       Mr = (12 - (Mi - Mf)) '***
       Ar = (Af - Ai) - 1
     End If

   ElseIf Mf = Mi Then
     If Df < Di Then
       Dr = 30 - (Di - Df)
       Mr = 11
       Ar = (Af - Ai) - 1
     ElseIf Df = Di Then
       Dr = 0
       Mr = 0
       Ar = Af - Ai
     Else
       Dr = (Df - Di)
       Mr = 0
       Ar = (Af - Ai)
     End If
   Else
     If Df < Di Then
       Dr = (30 - Di) + Df
       Mr = (Mf - Mi) - 1
     ElseIf Df = Di Then
       Dr = 0
       Mr = Mf - Mi
     Else
       Dr = (Df - Di)
       Mr = (Mf - Mi)
     End If
     Ar = (Af - Ai)

   End If

 Ano = Ar
 Mes = Mr
 Dia = Dr

 End If



 If Ano > 1 Then
   Ano = Ano & " Anos"
 Else
   Ano = Ano & " Ano"
 End If

 If Mes > 1 Then
   Mes = Mes & " Meses"
 Else
   Mes = Mes & " Mês"
 End If

 If Dia > 1 Then
   Dia = Dia & " Dias"
 Else
   Dia = Dia & " Dia"
 End If

 If Ret = RetAno Then
   DMA = Ano
 Else
   DMA = Ano & ", " & Mes & ", " & Dia
 End If

End Function

Editado por kuroi
Adicionar tag CODE
Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...