Boa noite senhores não entendo quase nada de VBA e consegui o código abaixo na internet para calcular idade:
Public Function fncIdadeCompleta(DataNascimento As Date, Optional DataFinal As Date) As String
On Error GoTo trataerro
Dim Anos As Byte, Meses As Variant, Dias As Byte, DataRef As Date
If DataNascimento > DataFinal Or DataNascimento = 0 Or DataFinal = 0 Then
fncIdadeCompleta = ""
Exit Function
End If
If DataNascimento = DataFinal Then
fncIdadeCompleta = 0
Exit Function
End If
'Ajusta dataNascimento se cair em ano bissexto
DataNascimento = IIf(Format(DataNascimento, "mm/dd") = "02/29", DataNascimento - 1, DataNascimento)
Anos = DateDiff("d", DataNascimento, DataFinal) \ 365.25
DataRef = DateSerial(Year(DataFinal) + (Format(DataNascimento, "mmdd") > Format(DataFinal, "mmdd")), Format(DataNascimento, "mm"), Format(DataNascimento, "dd"))
Meses = DateDiff("m", DataRef, DataFinal) + (Format(DataNascimento, "dd") > Format(DataFinal, "dd"))
DataRef = DateSerial(Year(DataFinal), Format(DataFinal, "mm") + (Format(DataNascimento, "dd") > Format(DataFinal, "dd")), Format(DataNascimento, "dd"))
DataRef = IIf(Format(DataNascimento, "dd") <> Format(DataRef, "dd"), DataRef - Format(DataRef, "dd"), DataRef)
Dias = CDbl(DataFinal) - CDbl(DataRef)
fncIdadeCompleta = IIf(Anos <= 1, IIf(Anos = 0, "", Anos & " ano "), Anos & " anos ") & _
IIf(Meses <= 1, IIf(Meses = 0, "", Meses & " mes "), Meses & " meses ") & _
IIf(Dias <= 1, IIf(Dias = 0, "", Dias & " dia "), Dias & " dias ")
sair:
Exit Function
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume sair:
End Function
Como adaptar esse código para calcular uma idade baseada na data atual do sistema.
obrigado!
Public Function fncIdadeCompleta(DataNascimento As Date, Optional DataFinal As Date) As String
On Error GoTo trataerro
Dim Anos As Byte, Meses As Variant, Dias As Byte, DataRef As Date
If DataNascimento > DataFinal Or DataNascimento = 0 Or DataFinal = 0 Then
fncIdadeCompleta = ""
Exit Function
End If
If DataNascimento = DataFinal Then
fncIdadeCompleta = 0
Exit Function
End If
'Ajusta dataNascimento se cair em ano bissexto
DataNascimento = IIf(Format(DataNascimento, "mm/dd") = "02/29", DataNascimento - 1, DataNascimento)
Anos = DateDiff("d", DataNascimento, DataFinal) \ 365.25
DataRef = DateSerial(Year(DataFinal) + (Format(DataNascimento, "mmdd") > Format(DataFinal, "mmdd")), Format(DataNascimento, "mm"), Format(DataNascimento, "dd"))
Meses = DateDiff("m", DataRef, DataFinal) + (Format(DataNascimento, "dd") > Format(DataFinal, "dd"))
DataRef = DateSerial(Year(DataFinal), Format(DataFinal, "mm") + (Format(DataNascimento, "dd") > Format(DataFinal, "dd")), Format(DataNascimento, "dd"))
DataRef = IIf(Format(DataNascimento, "dd") <> Format(DataRef, "dd"), DataRef - Format(DataRef, "dd"), DataRef)
Dias = CDbl(DataFinal) - CDbl(DataRef)
fncIdadeCompleta = IIf(Anos <= 1, IIf(Anos = 0, "", Anos & " ano "), Anos & " anos ") & _
IIf(Meses <= 1, IIf(Meses = 0, "", Meses & " mes "), Meses & " meses ") & _
IIf(Dias <= 1, IIf(Dias = 0, "", Dias & " dia "), Dias & " dias ")
sair:
Exit Function
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume sair:
End Function
Como adaptar esse código para calcular uma idade baseada na data atual do sistema.
obrigado!