Ir para conteúdo
Fórum Script Brasil

Nenel

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre Nenel

Nenel's Achievements

0

Reputação

  1. Nenel

    Calculo Idade

    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
×
×
  • Criar Novo...