[Resolvido]Contar Horas

Boa tarde.
Eu tenho 5 campos ( data inicio, data fim, hora inicio, hora fim e total de horas).
Gostaria de saber como posso fazer a contagem de horas imaginem do dia 01-01-2015 a 05-01-2015. O operário trabalhou das 8:30 ás 18h nos 4 dias = trabalhou 34 horas.
Conseguem me ajudar a fazer a formula?

Olá djsa79,

Veja minha solução neste tópico:

http://maximoaccess.forumeiros.com/t21504-somando-horas-e-minutos-acima-de-24-horas-agora-tambem-os-segundos

Não percebi muito bem good guy. No exemplo que me mostrou não tem datas....

Olá djsa,

Para efeito de formulário ou relatório, crie filtros entre datas e faça os cálculos desejados. Por exemplo, vc poderia colocar duas caixas de texto não acopladas no formato de datas. Ao selecionar a data no calendário suspenso para início e fim, o formulário faria o filtro entre essas datas através do código de um botão e a função faria a soma das horas.

Não consigo. Algo me falta. Conta as horas mas se tiver 2 dias só conta as horas

Olá amigo,

Tenho a solução pra você. O que preciso saber é se está satisfeito com a contagem das horas? Pela manhã, postarei uma solução para você contar os dias. Ok?

Boas. As horas conta bem mas se tiver 2 dias só conta 1 dia

Olá amigo,

Como está o seu filtro? Veja um exemplo de como filtro e conto os dias também.

Código:


Private Sub cmdAtualizar_Click()

'Faz o filtro do nome do funcionário
Dim sNome As String
sNome = InputBox("Informe o Nome:", "Consulta")    

Me.RecordSource = "SELECT * FROM SuaTabeladoFormulário WHERE NOME = '" & sNome & "'"

'Calcula as horas trabalhadas
Call SomaHoras(txtSomaHoras)

'Calcula o número de dias trabalhados por funcionário filtrado
Call ContaDias
End Sub

Public Sub ContaDias ()
Dim sTrabalhado As Integer
Dim strSQL As String
Dim strNome As String
Dim sCod As Long

sCod = DLookup("IDNOME", "tblProfissao", "NOME=FORMS![Gerenciador de Serviços]!NOME")    'Procuro o código ID do nome do funcionário pela sua profissão ou cargo na tabela apropriada, neste caso tblProfissao
sTrabalhado = Nz(DCount("NOME", "SuaTabeladoFormulário", "IDNOME= " & sCod))  'Calculo o número de dias

Me.TDiaTrabalhado = sTrabalhado    'Sua caixa de texto de nome TDiaTrabalhado receberá o resultado do cálculo

End Sub

Olá good guy. Eu não estou a perceber muito bem  e peço desculpa. Envio em anexo o exemplo que lhe falo. Apenas quero que ao introduzir o dia e o horário de trabalho inicio e fim, me apareça o total de horas que levou a ser escolhida aquela peça.

Olá,

Não veio o anexo.

Peço desculpa. Agora sim.

Olá amigo,

Veja se te atende,

Bom dia Good Guy.

Desde já agradeço a dedicação pelo meu problema.
Estive a testar o formulário e por exemplo: Data inicio:01-01-2015, hora inicio:8:30, Data fim 01-01-2015, hora fim:18:00 devia dar 9.5 mas está a dar 10.5. Está a contar 1 hora a mais.
Eu gostaria também se fosse possível contar as horas só de trabalho das 8:30 ás 12:30 e 13:30 ás 18:00 será possível.

Olá amigo,

Considerando a hora do almoço como intervalo de 1 hora que é o espaço de tempo que vc especificou entre 12:30 e 13:30.

A função que define os intervalos de tempo para que não se subtraia o intervalo de almoço entre períodos anteriores a 12:30:00 ou posteriores a 13:30:00.

Código:


Public Function Diferenca()
On Error Resume Next
Dim intervalo As Date

If HoraFim - HoraInicio >= #8:00:00 AM# Then
intervalo = "01:00:00"
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
ElseIf (HoraFim - HoraInicio) >= #6:00:00 AM# And (HoraFim - HoraInicio) < #8:00:00 AM# Then
intervalo = "00:15:00"
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
ElseIf HoraInicio >= #10:00:00 AM# And HoraInicio <= #11:59:59 AM# And HoraFim = #1:00:00 PM# Then
intervalo = "00:00:00"
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
ElseIf HoraInicio >= #6:00:00 PM# And HoraInicio <= #11:59:59 PM# And HoraFim <= #6:00:00 AM# Then
intervalo = "01:00:00"
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
Else
HoraTrabalhada = (HoraFim - HoraInicio)
End If


End Function

Boas novamente.

Não estou a perceber.
Se das 8:30 ás 12:30 = 4 horas.
Se das 13:30 ás 18:00 =4h30
Total= 8h30. No calculo que tem neste momento soma 9h30 correcto?

Outra situação.
Se do dia 01-01-2015 a 02-01-2015 são 2 dias de trabalho no calculo só soma 1 dia.
No total dos dois dias seriam são 17horas e não 33h30 minutos.

E não estou a perceber onde ele calcula uma hora a mais.

OK. Consegui.

Para contar os dias:

Na fonte de controle da caixa de texto (DifDatas)

Código:


=SeImed(DifData("d";[DataInicio];[DataFim])=0;1;DifData("d";[DataInicio];[DataFim])+1)

O código da função completa ficou assim:

Olá pessoal,

Por estar reunindo em ebook meus códigos e para proteger meus direitos autorais me vi impossibilitar de divulgar este meu código. Aguardem a divulgação de meu ebook.

Eduardo V. Machado (Good Guy)

Assim já percebi as alterações. Muito obrigado pela ajuda. Já aprendi alguma coisa

Olá amigão,

O fórum todo agradece.

Se você quiser fazer uma crítica ao usuário caso ele insira um horário diferente de trabalho, faça assim:

Código:


Private Sub cmdCalcular_Click()
If Not IsNull([Hora Inicio]) Or Not IsNull([Hora Fim]) Then
  If Me.HoraInicio <> #8:30:00 AM# Or Me.HoraFim <> #6:00:00 PM# Then
  MsgBox "Início de jornada de trabalho não especificado. " & vbCrLf & _
  "Correto: 08:30:00. Ou" & vbCrLf & _
  "Fim de jornada de trabalho não especificado. " & vbCrLf & _
  "Correto: 18:00:00.", vbCritical, "Controle do Ponto"
  Else
    Call Diferenca
    Call SomaHoras
  End If
Else
MsgBox "Preencha os campos das horas, por favor !!!", vbCritical, "Registos de escolhas"
End If
End Sub

Obs: Visite também o meu site e adquira para um ter um excelente aproveitamento em Access VBA o e-book TÉCNICAS ESPECIAIS DE ACCESS VBA !!! No Facebook dê uma curtida na página também. Vamos apoiar a tecnologia VBA para o ACCESS !!! Se quiser adquiri-lo, envie-me sua solicitação para um dos seguintes emails:

(1)eduardovmachado2007@hotmail.com
(2)eduardomachado@goodguyaccessvba.com.br
(3)sistemasvba@goodguyaccessvba.com.br

Site: www.goodguyaccessvba.com.br

Facebook:
https://www.facebook.com/EduardoMachado

Boas amigo.
Despois de uma semana a testar o programa reparei que nem sempre a contagem de horas é correta, porque será?
Faça por exemplo do dia Data inicio 22-01-2015 8:30 - data fim 22-01-2015 9:00 por vezes conta 0:00 minutos e devia contar 0:30 minutos

Olá,

O código está configurado para contabilizar as horas trabalhadas das 08:30 às 18:00 como vc me pediu e a partir do número de dias. Se você colocar um período menor de horas trabalhadas não vai somar. Modifiquei a função Diferença e deve calcular sem essa diferenciação de horários.

Código:


Public Function Diferenca()
On Error Resume Next
Dim intervalo As Date
intervalo = "01:00:00"

If HoraInicio >= #8:30:00 AM# And HoraFim <= #11:59:00 AM# Then
HoraTrabalhada = (HoraFim - HoraInicio)
Else
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
End If


End Function

Código do botão "Calcular":

Código:


Private Sub cmdCalcular_Click()
On Error Resume Next
If Not IsNull([Hora Inicio]) Or Not IsNull([Hora Fim]) Then
  If Me.HoraInicio >= #8:30:00 AM# Or Me.HoraFim <= #6:00:00 PM# Then
    Call Diferenca
    Call SomaHoras
  End If
Else
MsgBox "Preencha os campos das horas, por favor !!!", vbCritical, "Registos de escolhas"
End If
End Sub

Alguém me pode ajudar?

Olá,

Não estava conseguindo visualizar a imagem aqui no serviço e só agora vi o problema. Um instante ...

1ª Dúvida: o programa contabiliza as horas totais a partir das 08:30:00 até 18:00:00?

Se sim, a função está calculando correto, certo? E mesmo que ele chegue atrasado na parte da manhã, contabiliza correto também, certo?

2ª Dúvida: o funcionário pode vir a hora que ele quiser e sair na hora que ele quiser sem obedecer um padrão? Chega na parte da tarde e sai na parte da manhã 3(três) dias depois????
No meu entender, complica um pouco a soma das horas.

Alterei a função Diferença, mas não vai ajudar muito.

Código:


Public Function Diferenca()
On Error Resume Next
Dim intervalo As Date
intervalo = "01:00:00"

Select Case HoraInicio
Case Is >= #8:30:00 AM# And HoraFim <= #11:59:00 AM#
HoraTrabalhada = (HoraFim - HoraInicio)
Case Is >= #1:00:00 PM# And HoraFim <= #6:00:00 PM#
HoraTrabalhada = (HoraFim - HoraInicio)
Case Is >= #8:30:00 AM# And HoraFim <= #6:00:00 PM#
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
End Select

End Function

Vamos por partes.

O horário semanal é sempre das 8:30 AM até ás 06 PM com uma hora de almoço 12:30 ás 13:30.

Se eu tiver um funcionário a fazer uma escolha se essa escolha não acabar no mesmo dia, acabar 3 dias mais tarde.
Então deve contar assim: dia 21-01-2015 ás 8:30 AM até ao dia 23-01-2015 ás 6:00 PM isto é igual a 8h30 + 8:30 + 8.30 = 25h30 é esta contagem que não estava correta.

Olá,

Modifique a função Diferenca para:

Código:


Public Function Diferenca()
On Error Resume Next
Dim intervalo As Date
intervalo = "01:00:00"


If HoraInicio >= #8:30:00 AM# And HoraFim <= #6:00:00 PM# Then
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
Else
HoraTrabalhada = (HoraFim - HoraInicio)
End If
End Function


Teste contando um dia de cada vez, lembrando que a soma acima de 24h não é uma simples aritmética. Tem que obedecer a função que está no código.
Contei 1 dia 8 horas e 30 min, 2 dias 17 horas, 3 dias 26 horas e 30min, 4 dias 34 horas. Percebo que após 3 dias deveria somar 25 horas e 30 min, mas ainda não consegui descobrir onde possa estar o erro se na função SomaHoras ou na função Diferença.

Boas amigo. Já com o seu código alterado. É isso mesmo.

Ao terceiro dia conta uma hora a mais.

Consegui finalmente.  Era somente uma questão de lógica. A cada dia ímpar ocorria o problema por um pequeno detalhe na função SomaHoras. Veja como deve ficar o código:


Código do botão que faz o cálculo:

Código:


Private Sub cmdCalcular_Click()
Dim i As Integer
If Not IsNull([Hora Inicio]) Or Not IsNull([Hora Fim]) Then
  If Me.HoraInicio >= #8:30:00 AM# Or Me.HoraFim <= #6:00:00 PM# Then
  i = Me.DifDatas
    If i Mod 2 <> 0 Then    'Se o número de dias for ímpar faça o seguinte busque a função SomaHoras que subtrairá 1 hora
    Call Diferenca
    Call SomaHoras
    Else                            'Caso contrário busque a função SomaHorasII que manterá a contagem/soma normal
    Call Diferenca
    Call SomaHorasII
    End If
  End If
Else
MsgBox "Preencha os campos das horas, por favor !!!", vbCritical, "Registos de escolhas"
End If
End Sub

[code]

Olá pessoal,

Por estar reunindo em ebook meus códigos e para proteger meus direitos autorais me vi impossibilitar de divulgar este meu código. Aguardem a divulgação de meu ebook.

Eduardo V. Machado (Good Guy)

Obrigado Good Guy. Agora sim funciona a 100%

Então dj? Deus não é muito bom?

O fórum todo agradece pelo retorno.

Se algum dia quiser baixar meus aplicativos e tutoriais e, ainda também adquirir meu e-book de Técnicas de Access VBA acesse meu site:

http://www.goodguyaccessvba.com.br/ti_36.html

Contato:
eduardovmachado2007@hotmail.com
eduardomachado@goodguyaccessvba.com.br
sistemasvba@goodguyaccessvba.com.br

Curta também minha página no Facebook e ajude a promover o Access VBA.

https://www.facebook.com/EduardoMachado

Continua a contar mal antes da hora do almoço não conta corretamente.

Olá dj, como não?

A contagem está correta, salvo o sinal negativo. É só colocar a função Abs para tornar positivo a hora nas duas funções SomaHoras.

Código:


TotalHoras = Abs(Val(SomaH) + Val(SomaHM) - 1)

Modifiquei a função Diferenca, mas creio que será de pouca valia.

Código:


Public Function Diferenca()
On Error Resume Next
Dim intervalo As Date
intervalo = "01:00:00"


If HoraInicio >= #8:30:00 AM# And HoraFim <= #6:00:00 PM# Then
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
ElseIf HoraInicio >= #8:30:00 AM# And HoraFim <= #12:30:00 PM# Then
HoraTrabalhada = (HoraFim - HoraInicio)
ElseIf HoraInicio >= #12:30:00 AM# And HoraFim <= #6:00:00 PM# Then
HoraTrabalhada = (HoraFim - HoraInicio)
Else
HoraTrabalhada = (HoraFim - HoraInicio)
End If
End Function

Bom dia Good guy.

Pelas minhas contas das 8:40 ás 9:20 são 40 minutos e não -1h20!!!!

Tem razão. Mas se a presidente Dilma pode errar dizendo que 4 para 13 são 7...

Teste agora:

Cheque a imagem

Bom dia Good guy.

Já funciona na parte de manhã.

Agora na soma de vários dias....

Olá,

Se após alguns dias, a hora de saída for na parte da tarde somará tranquilo. Não vejo o porquê vc colocar um horário da parte da manhã no campo da hora de saída. Isso é realmente necessário?

Boas good Guy.

Sim é necessário porque existem escolhas que demoram 30 minutos, outras escolhas demoram dias.

Sinto muito dj,

Não consigo ir mais além do que já estabeleci até meu último post no que diz respeito a formulário simples, talvez seja a questão de impor um multiplicador ou a adição de 8:30 por dia mais essa pequena diferença em horas no último dia na parte da manhã. Vou ver o que posso fazer na segunda-feira. No entanto, existe uma outra solução, se vc montar seu aplicativo em formulário contínuo alcançará o seu objetivo. Veja este link abaixo:

http://maximoaccess.forumeiros.com/t21504-somando-horas-e-minutos-acima-de-24-horas-agora-tambem-os-segundos


Altere, porém, esta função, de 12:30 para 1:30 na primeira linha:

Código:


Public Function DiferencaIII()
If HoraInicio >= #1:30:00 PM# And HoraFim <= #6:00:00 PM# Then
HoraTrabalhada = (HoraFim - HoraInicio)
Else
MsgBox "Fora da faixa de horários (08:30 a 18:00)", vbCritical, "Aviso"
End If
End Function


Modifique também a função Diferenca:

Código:


Public Function Diferenca()
On Error Resume Next
Dim intervalo As Date
intervalo = "01:00:00"


If HoraInicio >= #8:30:00 AM# And HoraFim <= #6:00:00 PM# Then
HoraTrabalhada = (HoraFim - HoraInicio) - intervalo
Else
MsgBox "Fora da faixa de horários (08:30 a 18:00)", vbCritical, "Aviso"
End If

End Function

Olá dj,

Veja se é isto o que vc quer, criei uma nova função:

ATENÇÃO: Fiz uma correção nesta função !!!!!!!!!!!!!!!!!!!!!!!!!! Copie e cole esta função no seu aplicativo !!!!!!!!!!!!!!!

Código:


Public Function SomaHorasIII()
Dim sHoras As Variant
Dim sMinutos As Variant
Dim i As Integer
Dim sHoraTotal
i = Me.DifDatas

If i Mod 2 <> 0 Then
sHoras = Mid(HoraTrabalhada, 1, 2)
sHoras = Abs((Val(sHoras) + (i - 1) * 8)) + 1
sHoras = Format(sHoras, "00")

sMinutos = Mid(HoraTrabalhada, 4, 5)
sMinutos = Abs(Format(Abs(Val(sMinutos)), "00"))
sMinutos = Format(sMinutos, "00")
sHoraTotal = sHoras & ":" & sMinutos & ""
Me.TotalHoras2 = sHoraTotal
Else
sHoras = Mid(HoraTrabalhada, 1, 2)
sHoras = Abs((Val(sHoras) + (i - 1) * 8)) + 1
sHoras = Format(sHoras, "00")

sMinutos = Mid(HoraTrabalhada, 4, 5)
sMinutos = Abs((Format(Abs(Val(sMinutos)), "00") + 30) - 60)
sMinutos = Format(sMinutos, "00")
sHoraTotal = sHoras & ":" & sMinutos & ""
Me.TotalHoras2 = sHoraTotal
End If
End Function


Esta função é disparada a partir do código deste botão:

Código:


Private Sub cmdCalcular_Click()
On Error Resume Next

If Not IsNull([Hora Inicio]) Or Not IsNull([Hora Fim]) Then

Dim strMsg As String
Dim intRetval As Integer

strMsg = InputBox("Selecione o cálculo adequado: " & vbCrLf & _
"1 - No mesmo dia, na parte da manhã " & vbCrLf & _
"2 - No mesmo dia, na parte da tarde " & vbCrLf & _
"3 - Entre dias ou no mesmo dia de manhã até a tarde " & vbCrLf & _
"4 - Entre dias com fim da jornada pela manhã " & vbCrLf & _
"5 - Sair", "Contar Horas")

Select Case strMsg
Case Is = 1
  Call DiferencaII
  Call SomaHoras
  Me.TotalHoras2.Visible = False
  Me.TotalHoras.Visible = True
Case Is = 2
  Call DiferencaIII
  Call SomaHoras
  Me.TotalHoras2.Visible = False
  Me.TotalHoras.Visible = True
Case Is = 3

Dim i As Integer


  If Me.HoraInicio >= #8:30:00 AM# Or Me.HoraFim <= #6:00:00 PM# Then
  i = Me.DifDatas
    If i Mod 2 <> 0 Then
    Call Diferenca
    Call SomaHoras
    Me.TotalHoras.Visible = True
    Me.TotalHoras2.Visible = False
    Else
    Call Diferenca
    Call SomaHorasII
    Me.TotalHoras.Visible = True
    Me.TotalHoras2.Visible = False
    End If
    
  End If

Case Is = 4
  Call DiferencaII
  Call SomaHoras
  Me.TotalHoras2.Visible = True
  Me.TotalHoras.Visible = False
  Call SomaHorasIII
End Select
End If
End Sub

Boas Good Guy. Só hoje é que consegui ver o trabalho que fez. Já copiei ocódigo mas dá me um erro quando carrego em calcular. Vou enviar a minha base de dados.

Olá dj,

Delete este arquivo que vc fez alterações. Tente com outro novo extraído do arquivo .zip. Imaginei que vc já tinha baixado meu antigo arquivo .zip. Hoje deletei o arquivo .zip existente e fiz o upload de um novo com o novo código.

Desde já quero agradecer o tempo dispensado pelo meu problema.

Agora sim tenho a tabela a funcionar 100%.

Obrigado por tudo. Até uma próxima

Obrigado, me deu um suadouro.... kkkk, mas o fórum todo agradece o retorno !!!

Boas novamente.

Continuo com problemas ao contar. Poderia me ajudar novamente?
Teria que dar 20h30.
Obrigado

Olá colega,

Posta o aplicativo, por favor.

Bom dia.

tenho este problema: Não é possível enviar o arquivo : o espaço total de armazenamento foi ultrapassado. (Espaço restante : 138 Kb)

Use o dropbox ou o 4shared.com.

Aqui está

https://www.dropbox.com/s/v4xqn7bni5x4wn1/Registros%20de%20escolhas.accdb?dl=0

Olá dj,

Estava trabalhando no programa, mas me esqueci de salvar no pendrive na versão do Access 2007 que tenho em casa. No formato Access 2010 não aceita abrir. Como entrei de férias não dá pra fazer isso no serviço. Pode me reenviar no formato do Access 2007?

Boa tarde Good guy.

Eu estou a trabalhar com o office 2013. Não me deixa gravar em 2007.

Olá dj,

A não ser que vc encontre uma solução para resolver isso, só em Julho quando eu retornar das férias. Nessa primeira semana, ainda estou livre.