Função para transformas dias em Ano,Mes,Dias

'---------------------------------------------------------------------------------------
' Procedure     : AnoMesDiaConv
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 6/2/2013
' Comentários   : Função para converter dias em Ano,Mes,Dia
'---------------------------------------------------------------------------------------
Public Function AnoMesDiaConv(StrDias As Double) As String
Dim StrAno As Double, StrMes As Double, StrDia As Double
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo TrataErro
Dim NomeProcedimento As String
    NomeProcedimento = "AnoMesDiaConv"
    'Adiciona o nome do procedimento à função
    PegaProcedimento (NomeProcedimento)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
StrAno = StrDias / 365
StrMes = StrDias / 365
    StrAno = Left(StrAno, InStrRev(StrAno, ","))
    StrMes = Mid(StrMes, InStrRev(StrMes, ","))
    StrMes = StrMes * 365
    StrMes = Left(StrMes, InStrRev(StrMes, ","))
If StrMes < 30 Then
    StrDia = StrMes
    StrMes = 0
Else
    StrMes = StrMes / 30
    StrDia = Mid(StrMes, InStrRev(StrMes, ","))
    StrMes = Left(StrMes, InStrRev(StrMes, ","))
    StrDia = StrDia * 30
    StrDia = Left(StrDia, InStrRev(StrDia, ","))
 End If
 
'Modifica o texto na função de acordo com a pluralidade e numero de Anos, meses e dias
If StrAno = 1 And StrMes = 1 And StrDia = 1 Then
    AnoMesDiaConv = StrAno & " Ano, " & StrMes & " Mes e " & StrDia & " Dia"
ElseIf StrAno > 1 And StrMes = 1 And StrDia = 1 Then
    AnoMesDiaConv = StrAno & " Anos, " & StrMes & " Mes e " & StrDia & " Dia"
ElseIf StrAno > 1 And StrMes > 1 And StrDia = 1 Then
    AnoMesDiaConv = StrAno & " Anos, " & StrMes & " Mesese e " & StrDia & " Dia"
ElseIf StrAno > 1 And StrMes = 1 And StrDia > 1 Then
    AnoMesDiaConv = StrAno & " Anos, " & StrMes & " Mesese e " & StrDia & " Dias"
ElseIf StrAno = 1 And StrMes > 1 And StrDia = 1 Then
    AnoMesDiaConv = StrAno & " Ano, " & StrMes & " Meses e " & StrDia & " Dia"
ElseIf StrAno = 1 And StrMes > 1 And StrDia > 1 Then
    AnoMesDiaConv = StrAno & " Ano, " & StrMes & " Meses e " & StrDia & " Dias"
ElseIf StrAno = 1 And StrMes = 1 And StrDia > 1 Then
    AnoMesDiaConv = StrAno & " Ano, " & StrMes & " Mes e " & StrDia & " Dias"
ElseIf StrAno > 1 And StrMes > 1 And StrDia > 1 Then
    AnoMesDiaConv = StrAno & " Anos, " & StrMes & " Meses e " & StrDia & " Dias"
ElseIf StrAno = 0 And StrMes > 1 And StrDia > 1 Then
    AnoMesDiaConv = StrMes & " Meses e " & StrDia & " Dias"
ElseIf StrAno = 0 And StrMes = 1 And StrDia > 1 Then
    AnoMesDiaConv = StrMes & " Mes e " & StrDia & " Dias"
ElseIf StrAno = 0 And StrMes > 1 And StrDia = 1 Then
    AnoMesDiaConv = StrMes & " Meses e " & StrDia & " Dia"
ElseIf StrAno = 0 And StrMes = 0 And StrDia > 1 Then
    AnoMesDiaConv = StrDia & " Dias"
ElseIf StrAno = 0 And StrMes = 0 And StrDia = 1 Then
    AnoMesDiaConv = StrDia & " Dia"
End If
Exit Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
Exit Function
TrataErro:
    Select Case err.Number
  Case 13
Resume Next
      'AnoMesDiaConv = StrAno & " Ano(s) "
  Case Else
      DoCmd.Hourglass False
      DoCmd.Echo True
      'Chama a função global de tratamento de erros
        GlobalErrHandler ("mdlCalculaPrograssaoCOmpleta")
  End Select
End Function