MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

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

    HARYSOHN
    HARYSOHN
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12227
    Registrado : 01/03/2011

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

    Mensagem  HARYSOHN em 6/2/2013, 14:04


    '---------------------------------------------------------------------------------------
    ' 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


    Enjoy!!!

    *****************************************************************************************************************



    Repositório de Exemplos Ms Access
    Sala destinada à colocação de exemplos em Ms Access (Código aberto) de e para
    todos os Utilizadores Cadastrados.
    Não tirar duvidas nesta sala.

      Data/hora atual: 4/12/2020, 04:24