MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Eroo em tempo de execução 13

    Compartilhe

    Kaynan
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2340
    Registrado : 09/04/2012

    [Resolvido]Eroo em tempo de execução 13

    Mensagem  Kaynan em 3/2/2014, 13:10


    Bom dia amigos, tenho esse exemplo,que ao abrir da erro de exeução 13,mas notei que aconteceu esse erro quando passamos pro mes de fevereiro, se eu atraso o computador um mes ou adianto um mes não da erro,só acontece no mes 2 fevereiro.
    Algum colega poderia dar uma olhada pra mim, ele depura para uma linha,mas não descobri oque acontece.
    Abçs.


    [Você precisa estar registrado e conectado para ver este link.]
    avatar
    criquio
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11240
    Registrado : 30/12/2009

    Re: [Resolvido]Eroo em tempo de execução 13

    Mensagem  criquio em 3/2/2014, 15:32

    Não tenho certeza se entendi bem. A necessidade é calcular idade/quantidade de anos entre uma data passada e agora? Se for isso, dê uma olhada em um pequeno artigo que escrevi em meu blog sobre uma forma simples de fazer esse cálculo. O título é "Calcular idade de forma simples e eficiente em VBA". Dê um Ctrl+F para abrir a pesquisa e digite "Calcular idade" que o browser cairá no início do artigo. Veja se ajuda.


    .................................................................................
    Meu novo site: [Você precisa estar registrado e conectado para ver este link.]

    Clique aqui e veja um vídeo que explica como fazer pesquisas no forum.


    DICA: Quando precisar inserir um exemplo do seu aplicativo, siga os procedimentos abaixo:
    1 - faça uma cópia do aplicativo
    2 - retire tudo que não for necessário à solução do problema, exceto o que o aplicativo precisar para funcionar
    3 - use o Compactar/Reparar
    4 - compacte o aplicativo em zip ou rar (zip para postagem como anexo na mensagem)


    Agradeça a quem lhe ajudou, clicando no joinha de uma das mensagens do usuário.
    Positive as mensagens que achar útil, no canto superior direito delas.

    avatar
    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1218
    Registrado : 05/02/2010

    Eroo em tempo de execução 13

    Mensagem  good guy em 3/2/2014, 15:36

    Olá Kaynan,

    O código funfa perfeitamente dessa maneira:

    Function CalculaIdade(DataNascimento As Date) As Long
    On Error Resume Next                                  'Tratamento de erro para eliminar o aviso de erro por falha na compilação
     If IsNull(DataNascimento) Then
       CalculaIdade = ""
       Exit Function
     End If
     Dim intAnos As Integer, intMeses As Integer, intDias As Integer
     Dim AnoHoje As Date, DiaHoje As Date, MesHoje As Date   'Tipos corretos para esses dados
     Dim DiaNasc As Date, MesNasc As Date, AnoNasc As Date   'Tipos corretos para esses dados
     Dim DataAux As Date
     DiaHoje = Day(Date)
     MesHoje = Month(Date)
     AnoHoje = Year(Date)
     DiaNasc = Day(DataNascimento)
     MesNasc = Month(DataNascimento)
     AnoNasc = Year(DataNascimento)
     intAnos = AnoHoje - AnoNasc
     If MesHoje = MesNasc Then
        If DiaHoje < DiaNasc Then
          intAnos = intAnos - 1
          intMeses = 11
          DataAux = DateAdd("m", -1, DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
          intDias = Int(Date - DataAux)
        ElseIf DiaHoje = DiaNasc Then
          intMeses = 0
          intDias = 0
        Else
          intMeses = 0
          intDias = Int(Date - DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
        End If
     ElseIf MesHoje < MesNasc Then
        intAnos = intAnos - 1
        If DiaNasc = 29 And MesNasc = 2 Then
          intMeses = CInt(DateDiff("m", DateValue(DiaNasc - 1 & "/" & MesNasc & "/" & AnoHoje - 1), Date))   'Conversão para tipo Integer
        Else
          intMeses = CInt(DateDiff("m", DateValue(DiaNasc & "/" & MesNasc & "/" & AnoHoje - 1), Date))    'Conversão para tipo Integer
        End If
        If DiaHoje = DiaNasc Then
           intDias = 0
        ElseIf DiaHoje < DiaNasc Then
           intMeses = intMeses - 1
           DataAux = DateAdd("m", -1, DateValue((DiaNasc - 1) & "/" & MesHoje & "/" & AnoHoje))
           intDias = Int(Date - DataAux)
        Else
           intDias = Int(Date - DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
        End If
     Else
        intMeses = DateDiff("m", DateValue(MesNasc & "/" & AnoHoje), Date)
        If DiaHoje = DiaNasc Then
           intDias = 0
        ElseIf DiaHoje < DiaNasc Then
           intMeses = intMeses - 1
           DataAux = DateAdd("m", -1, DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
           intDias = Int(Date - DataAux)
        Else
           intDias = Int(Date - DateValue(DiaNasc & "/" & MesHoje & "/" & AnoHoje))
        End If
     End If
     CalculaIdade = intAnos
    CalculaIdade_Fim:
     Exit Function
    End Function

    Kaynan
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2340
    Registrado : 09/04/2012

    Re: [Resolvido]Eroo em tempo de execução 13

    Mensagem  Kaynan em 3/2/2014, 16:26

    Perfeito good,com essas alterações ficou funcionando direitinho,obrigado amigo,obrigado Criquio.

    Valeu mesmo.
    avatar
    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1218
    Registrado : 05/02/2010

    Eroo em tempo de execução 13

    Mensagem  good guy em 3/2/2014, 17:35

    O fórum todo agradece.

      Data/hora atual: 26/9/2018, 09:49