Convidado 6/2/2013, 13:49
O Exemplo Final da Função:
'---------------------------------------------------------------------------------------
' 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
Cumprimentos.