MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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


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

    avatar
    Convidado
    Convidado


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

    Mensagem  Convidado 6/2/2013, 03:03

    Amigos estou cá fazendo uma função para realizar o citado acima,,,, Algum de vós tem alguma sugestão ou algo ja pronto?

    Vi algo no excell, mas dá tipos incompatíveis:

    Ano= DateDiff(0, StrDias, "Y")
    MEses = DateDiff(0, StrDias, "YM")
    Dias = DateDiff(0, StrDias, "MD")


    Onde StrDias é o numero de dias.

    Cumprimentos.
    avatar
    Convidado
    Convidado


    [Resolvido]Função para transformas dias em Ano,Mes,Dias Empty Re: [Resolvido]Função para transformas dias em Ano,Mes,Dias

    Mensagem  Convidado 6/2/2013, 03:26

    Fiz algo assim, se tiverem sugestões são bem vindas.



    '---------------------------------------------------------------------------------------
    ' 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 Long) 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
    End If
    AnoMesDiaConv = StrAno & " Ano(s), " & StrMes & " Mes(es) e " & StrDia & " Dia(s)"
    Exit Function
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'Tratamento de Erros
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
    Exit Function
    TrataErro:
    Select Case err.Number
    Case 13
    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
    avatar
    Convidado
    Convidado


    [Resolvido]Função para transformas dias em Ano,Mes,Dias Empty Re: [Resolvido]Função para transformas dias em Ano,Mes,Dias

    Mensagem  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.

    Conteúdo patrocinado


    [Resolvido]Função para transformas dias em Ano,Mes,Dias Empty Re: [Resolvido]Função para transformas dias em Ano,Mes,Dias

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 24/11/2024, 03:18