[Resolvido]Contar Adicional Noturno

Bom dia galera.

Tenho um sistema de cálculo de horas extras que funciona perfeitamente. Só que preciso incluir cálculo para adicional noturno.
Tenho um campo para hora de entrada: Hora_Ent e um para hora de Saída: Hora_Sai e um campo: Quant_Ad_Not

O que estou desenvolvendo já faz os cálculos das horas extras mesmo se for após 24 horas, o que preciso é que nesse campo (Quant_Ad_Not) após digitar a hora de entrada e hora de saída da hora extra. (Ex: 19:30 ás 03:30). Ele pegue somente o horário das 22:00 até ás 05:00 se for o caso) e jogue nesse campo.

O meu pega a hora cheia: 08:00 hs total. Quando na verdade deveria ser: 05:00 noturnas.

Tentei utilizar este código, mas não dá certo:

Código:


Function totalHoraNoturna(Hora_Ent As Date, Hora_Sai As Date) As Long

Dim intHoraInicio As Integer
Dim intHoraFim As Integer

intHoraInicio = IIf(Hour(Hora_Ent) < 22 And Hour(Hora_Ent) > 6, 22, Hour(Hora_Ent))
intHoraFim = IIf(Hour(Hora_Sai) > 6 And Hour(Hora_Sai) <= 22, 6, Hour(Hora_Sai))

If intHoraInicio >= 22 Then
    If intHoraFim > 22 Then
        totalHoraNoturna = intHoraFim - intHoraInicio
    Else
        totalHoraNoturna = 24 - intHoraInicio + intHoraFim
    End If
Else
    totalHoraNoturna = intHoraFim - intHoraInicio
End If



Obrigado.

Penso que será isto que você quer;

Código:

Function totalHoraNoturna(Hora_Ent As Date, Hora_Sai As Date) As Long
Dim intHoraInicio As Integer
Dim intHoraFim As Integer
Dim hr As Date
Dim hs As Date

hr = CDate(Date & " " & "22:00:00")
hs = CDate(Date + 1 & " " & Hora_Sai)

intHoraInicio = Hour(Hora_Ent)
intHoraFim = Hour(Hora_Sai)

If intHoraInicio >= 22 And intHoraFim <= 5 Then
        totalHoraNoturna = intHoraInicio - intHoraFim
    Else
        totalHoraNoturna = 0
End If

If intHoraInicio < 22 And intHoraFim < 5 Then
        totalHoraNoturna = DateDiff("h", hr, hs)
    Else
        totalHoraNoturna = 0
End If
End Function

Olá Paulo, obrigado por me ajudar.

chamei a função no campo após atualizar assim:

Código:


Quant_Ad_Not = totalHoraNoturna(Hora_Ent, Hora_Sai)


Só que não acontece nada.

Repare que Hora_Ent e Hora_Sai são variáveis da função;

No limite você deveria de invocar assim;

Código:

Quant_Ad_Not = totalHoraNoturna(SeuCampoEntra, SeuCampoSai)

Num botão, teste isto;

MsgBox totalHoraNoturna(#7:30:00 PM#, #3:30:00 AM#)

Se devolver 5, está a funcionar.

Bem na verdade essa variável HoraEnt e Hora_Sai são os nomes dos meus campos.

Substitui as variáveis no código por HoraEntrada e HoraSaida.
Só que não armazena exibe o valor nem por decreto.
Com a Msgbox exibe certinho.

Alterei alguma coisa e exibe certinho as quantidades, só que não exibe o valor no campo nem a pau.

Eis o código alterado.

Código:


Function totalHoraNoturna(HoraEntrada As Date, HoraSaida As Date) As Long 'ALTEREI AQUI OS NOMES
Dim intHoraInicio As Integer
Dim intHoraFim As Integer
Dim hr As Date
Dim hs As Date

hr = CDate(Date & " " & "22:00:00")
hs = CDate(Date + 1 & " " & HoraSaida) ' ALTEREI AQUI TAMBÉM

intHoraInicio = Hour(HoraEntrada) 'ALTEREI AQUI TAMBÉM
intHoraFim = Hour(HoraSaida) 'ALTEREI AQUI TAMBÉM

If intHoraInicio >= 22 And intHoraFim <= 6 Then ' AQUI AUMENTEI PARA 6 AO INVÉS DE 5, POIS O HORÁRIO LIMITE É 5
    totalHoraNoturna = intHoraInicio - intHoraFim
Else
    totalHoraNoturna = 0
End If

If intHoraInicio < 22 And intHoraFim < 6 Then  ' AQUI AUMENTEI PARA 6 AO INVÉS DE 5, POIS O HORÁRIO LIMITE É 5
   
    totalHoraNoturna = DateDiff("h", hr, hs)
Else
    totalHoraNoturna = 0
End If

End Function



Outro detalhe é que se eu digitar a partir das 22:00 hs ou acima das 22:00 hs.
Ele exibe o resultado como zero, quando na verdade o adicional noturno inicia á partir das 22:00 hs.

Têm algo errado ai que não tô conseguindo entender.

No primeiro IF, altere de totalHoraNoturna = intHoraInicio - intHoraFim, para

totalHoraNoturna = DateDiff("h", CDate(Date  & " " & HoraEntrada) , CDate(Date+1 & " " & HoraSaida))

Erro:
Era esperado: )

Já coloquei parênteses em tudo que é lugar e nada.

Claudio,

baixe o arquivo exemplo deste seu tópico e teste.

Nota: copie e cole o link abaixo no seu navegador:

redeaccess.com.br/viewtopic.php?f=7&t=1977&p=8646#p8646

Sucesso!

Claudio, se você já resolveu aqui ou noutro site, é favor dar o tópico como Resolvido.

Bom dia.
Desculpa Paulo.
É que minha necessidade era grande e apelei para o Avelino também.
Mas só resolvi hoje, por isso não havia fechado.
Desculpe e obrigado pela sua ajuda que foi de grande valia.

Deixo meus agradecimentos a você e ao Avelino Sampaio.

Anexo o exemplo pra quem precisar.

Abraço