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

    Verifica atraso na entrada de um funcionario

    HARYSOHN
    HARYSOHN
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Verifica atraso na entrada de um funcionario Empty Verifica atraso na entrada de um funcionario

    Mensagem  HARYSOHN em 2/3/2013, 18:09

    De autoria de Heio Candido, disponibilizado abertamente na rede:


    'por: HELIO CANDIDO

    'Função de minha autoria.

    'OBS.: a rotina é um pouco extensa devido às mensagens que serão exibidas, mas se quizer é só
    'tirar as mensagens. Mas a função é executada com muita velocidade.

    'A função abaixo de minha autoria, faz verificação de hora conforme um horário que você
    'especificar, tipo verifica se você chegou atrasado, adiantado ou no horário.

    'Para usá-la use o seguinte código, imaginando que o critério seja 08:00
    'VerificarAtraso "08:00", Time


    Public Sub VerificarAtraso(HoraCriterio As String, HoraAtraso As String)

    Dim MinutosAtraso As String
    Dim MinutosCriterio As String
    Dim CriterioMinutos As Integer
    Dim AtrasoMinutos As Integer
    Dim CriterioHoras As Integer
    Dim AtrasoHoras As Integer
    Dim TotalHoraAtraso As Integer
    Const Minutos = 60
    Dim AlterarAtrasoHoras As Integer
    Dim AlterarAtrasoMinutos As Integer
    Dim NovoAtrasoMinuto As Integer

    'Atribui os valores dados pelo usuário
    MinutosAtraso = Minute(HoraAtraso)
    MinutosCriterio = Minute(HoraCriterio)

    'Transforma os valores dados em números para que possam ser feitos os cálculos
    'Minutos
    CriterioMinutos = Int(MinutosCriterio)
    AtrasoMinutos = Int(MinutosAtraso)

    'Horas
    CriterioHoras = Int(Hour(HoraCriterio))
    AtrasoHoras = Int(Hour(HoraAtraso))

    'Verifica se o usuário chegou em cima da hora, se positivo, ele é pontual
    If AtrasoMinutos = CriterioMinutos Then
    MsgBox "Você é pontual, tenha um bom trabalho!!!", vbInformation, "Pontualidade OK..."
    Exit Sub
    End If

    'Faz a verificação para saber os minutos de atraso e as horas também

    'Se tiver a hora do usuário for igual a hora de critério então verifica apenas
    'os minutos
    If AtrasoHoras = CriterioHoras Then
    AlterarAtrasoMinutos = AtrasoMinutos - MinutosCriterio
    AtrasoMinutos = AlterarAtrasoMinutos
    End If

    'Se o usuário tiver chegado depois da hora, verifica as horas e os minutos para
    'executar os cálculos referentes
    If AtrasoHoras > CriterioHoras Then

    'Verifica se os minutos são iguais aos minutos de critério
    'Esse código só vale caso o usuário tenha informado como critério uma hora que
    'tenha minutos diferentes de 0 (zero).
    If AtrasoMinutos = 0 Then
    AlterarAtrasoMinutos = Minutos - CriterioMinutos
    AtrasoMinutos = AlterarAtrasoMinutos

    AlterarAtrasoHoras = AtrasoHoras - 1
    AtrasoHoras = AlterarAtrasoHoras
    Else
    If AtrasoMinutos > 0 Then
    AlterarAtrasoMinutos = AtrasoMinutos - CriterioMinutos
    NovoAtrasoMinuto = AlterarAtrasoMinutos

    If AlterarAtrasoMinutos >= 0 Then
    AtrasoMinutos = AlterarAtrasoMinutos
    Else
    If AlterarAtrasoMinutos < 0 Then
    AlterarAtrasoMinutos = Minutos - CriterioMinutos
    AlterarAtrasoMinutos = AlterarAtrasoMinutos + AtrasoMinutos
    AtrasoMinutos = AlterarAtrasoMinutos

    AlterarAtrasoHoras = AtrasoHoras - 1
    AtrasoHoras = AlterarAtrasoHoras
    End If
    End If
    End If
    End If
    End If

    'Aqui verifica a hora de atraso
    If AtrasoHoras > CriterioHoras Then
    TotalHoraAtraso = AtrasoHoras - CriterioHoras
    Else
    TotalHoraAtraso = AtrasoHoras - CriterioHoras
    End If

    'Caso a hora de atraso seja menor a hora de criterio então verifica também os
    'minutos
    If TotalHoraAtraso < 0 Then
    'Caso os minutos de atraso sejam menores que o minuto de critério então
    'o usuário chegou adiantado
    If AtrasoMinutos < 0 Then
    MsgBox "Você chegou adiantado, bom trabalho!!!", vbInformation, "Adiantado..."
    Exit Sub
    End If
    End If

    If TotalHoraAtraso < 0 Then
    MsgBox "Você chegou adiantado, bom trabalho!!!", vbInformation, "Adiantado..."
    Exit Sub
    End If

    If TotalHoraAtraso = 0 Then
    If AtrasoMinutos < 0 Then
    MsgBox "Você chegou adiantado, bom trabalho!!!", vbInformation, "Adiantado..."
    Exit Sub
    End If
    End If

    'Conforme os resultados anteriores exibe as referidas mensagens de maneira correta
    If TotalHoraAtraso <> 0 Then
    If TotalHoraAtraso > 1 And AtrasoMinutos > 1 Then
    MsgBox "Você chegou atrasado " & TotalHoraAtraso & " horas e " & AtrasoMinutos & " minutos!!!", vbInformation, "Atraso..."
    End If

    If TotalHoraAtraso > 1 And AtrasoMinutos <= 1 Then
    If AtrasoMinutos <> 0 Then
    MsgBox "Você chegou atrasado " & TotalHoraAtraso & " horas e " & AtrasoMinutos & " minuto!!!", vbInformation, "Atraso..."
    Else
    MsgBox "Você chegou atrasado " & TotalHoraAtraso & " horas!!!", vbInformation, "Atraso..."
    End If
    End If

    If TotalHoraAtraso <= 1 And AtrasoMinutos > 1 Then
    MsgBox "Você chegou atrasado " & TotalHoraAtraso & " hora e " & AtrasoMinutos & " minutos!!!", vbInformation, "Atraso..."
    End If

    If TotalHoraAtraso <= 1 And AtrasoMinutos <= 1 Then
    If AtrasoMinutos <> 0 Then
    MsgBox "Você chegou atrasado " & TotalHoraAtraso & " hora e " & AtrasoMinutos & " minuto!!!", vbInformation, "Atraso..."
    Else
    MsgBox "Você chegou atrasado " & TotalHoraAtraso & " hora!!!", vbInformation, "Atraso..."
    End If
    End If
    Else
    If AtrasoMinutos > 1 Then
    MsgBox "Você chegou atrasado " & AtrasoMinutos & " minutos!!!", vbInformation, "Atraso..."
    End If

    If AtrasoMinutos <= 1 Then
    MsgBox "Você chegou atrasado " & AtrasoMinutos & " minuto!!!", vbInformation, "Atraso..."
    End If
    End If

    End Sub





    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: 3/12/2020, 08:26