Lançamento de horas duplicados

Olá.
Possuo uma tabela com o nome de todos os funcionários, outra com as horas trabalhadas deles através de ordens de serviço. Tenho um formulário onde estas horas trabalhadas são lançadas (Numero_os, funcionário, data, hora_inicio, hora_fim).
Estou com um problema que em certas ocasiões um funcionário aponta em uma ordem de serviço, por exemplo:

Nº O.S - 1
FUNCIONÁRIO - JOSÉ
DATA: 01/01/2015
HORA INICIO - 08:00
HORA FIM - 11:00

e em outra ordem de serviço:

Nº O.S - 2
FUNCIONÁRIO JOSÉ
DATA - 01/01/2015
HORA INÍCIO - 09:00
HORA FIM - 10:00

Ou seja, é impossível ele ter realizado a ordem de serviço nº 2 nesse horário, pois estava realizando a nº 1 das 8 as 11. Eu consegui barrar quando o mesmo funcionário preenche no mesmo dia horários iguais, mas com horas diferentes não consegui pensar em nada.

Alguém conhece alguma forma de conseguir pegar isso?

Olá Vinícius,

o que você deseja realmente? Criar um código que impeça o lançamento de dados incoerentes ou em cima de já existentes no mesmo dia, mesmo funcionário dentro do mesmo horário já existente? Se for este o caso, utilize a função DLookup. Não sei se vc já está familiarizado com esta função. Ela vai pesquisar na tabela se já houve este lançamento e impedir o cadastramento destes novos dados caso estejam incorrendo nesses parâmetros.

Olá good guy, agradeço sua resposta.

Conheço o DLookUp, mas ele no caso procuraria se existem lançamentos no mesmo horário, correto? O que procuro é evitar lançamentos que se cruzam, como citei no exemplo. Um registro das 8 as 10, e outro registro das 9 as 9:30 por exemplo. Os horários são diferentes, a ordem de serviço é diferente, mas é o mesmo funcionário no mesmo dia. Ele não pode ter executado um serviço das 9 as 9:30 sendo que já executou outro das 8 as 10, entende?

Olá Vinícius,

Ok, isso entendi. Mas essa função faz qualquer coisa em termos de pesquisa.

Poderia me mostrar um exemplo de como utilizaria o DlookUp nesse caso ?

Olá Vinícius,

Não testei porque teria que desenvolver o aplicativo propriamente dito. Testa aí com esta função e vê se te ajuda. Na saída do campo Nome de seu formulário chame esta função:

Código:


Public Sub Nome_Exit()

Call Procurar(txtNome)    'txtNome é o nome de sua caixa de texto acoplada à tabela, isto é, cuja fonte de dados é o campo Nome da sua tabela.

End Sub


Verifique se os nomes dos campos estão corretos, caso contrário vai corrigindo:

Código:


Public Function Procurar(sNome As String)
Dim sDate As Date

sDate = Forms!PesquisaFuncionario!DataInicio           'PesquisaFuncionario é o nome do seu formulário troque pelo seu nome verdadeiro

sNome = DLookup("Nome", "TabelaX", "DataInicio = #" & sDate & "#")    'Troque a TabelaX pelo nome de sua tabela

If Not IsNull(Nome) And Me.Nome <> sNome Then
   Exit Function
   Else
   If HoraInicio >= Me.HoraInicio And HoraInicio <= Me.HoraFim Then
       Me.Undo
  MsgBox "Este funcionário não poderia estar trabalhando no mesmo dia e dentro do mesmo horário já previamente cadastrado !!!", vbCritical, "Análise"
   Else
   MsgBox "Ok, prossiga !!!", vbInformation, "Análise"
   End If
  
End Function



Obrigado pela resposta good guy.

Testei aqui e alterei os nomes como solicitado. Ficou da seguinte forma:

Código:

Public Function Procurar(sNome As Integer)
Dim sDate As Date
sDate = Forms!FLançarHoras!data
sNome = DLookup("manutentor", "baixa", "data = #" & sDate & "#")

If Not IsNull(manutentor) And Me.data <> sNome Then
   Exit Function
   ElseIf hora_inicio >= Me.hora_inicio And hora_inicio <= Me.hora_final Then
      Me.Undo
  MsgBox "Este funcionário não poderia estar trabalhando no mesmo dia e dentro do mesmo horário já previamente cadastrado !!!", vbCritical, "Análise"
   Else
   MsgBox "Ok, prossiga !!!", vbInformation, "Análise"
   End If
  
End Function



Porém não está compilando pois aparece "uso inválido da palavra chave Me". Alterei então para Forms!FLançarHoras!, mas então quando inseri o código na saída do txtnome do formulário ele dá um erro: "Uso de null inválido", e ao depurar aponta o erro para "sNome = DLookup("manutentor", "baixa", "data = #" & sDate & "#")"

Poderia me ajudar?

Olá Vinícius,

Use a função Nz para verificar os campos nulos e passar para a função DLookup.

sNome = Nz(DLookup("manutentor", "baixa", "data = #" & sDate & "#"))

Resolveu em partes.
Mas creio que esta parte do código não está caindo no if:

Código:


   ElseIf hora_inicio >= Forms!FLançarHoras!hora_inicio And hora_inicio <= Forms!FLançarHoras!hora_final Then
       DoCmd.RunCommand (acCmdUndo)


Pois quando coloco somente o número da ordem de serviço e um funcionário ele aparece "Ok prossiga!!", e quando preencho com horas duplicadas ele permite da mesma forma. E quando deixo nulo o funcionário, ele retorna o erro novamente de que "uso de null é inválido", e ao depurar aponta para a chamada no evento sair do txtnome.

Sou um pouco leigo em vba, mas esse hora_inicio após o ElseIf não deveria ter outra coisa dizendo de onde é puxado? Se é da tabela de dados ou do formulário?

Caramba Vinicius,

Está cheio de furos, hein? rsrsrs Ok, posta aí o bd para eu poder raciocinar melhor, já que minha lógica de cara sem testar não deu certo.

Não estou conseguindo enviar o arquivo. Compactei em .zip, com um tamanho de 245kb, mas está retornando o erro: Não é possível enviar o arquivo : o espaço total de armazenamento foi ultrapassado. (Espaço restante : 0 Kb).

Possui algum e-mail no qual posso te enviar?

Aí vai:

eduardovmachado2007@hotmail.com

Enviado!

Olá Vinicius,

A função não deveria estar como módulo, mas no mesmo formulário. Modifiquei a função. Não mude nada por favor e teste:

Código:


Option Compare Database
Option Explicit

Private Sub hora_final_AfterUpdate()
On Error Resume Next
Call Procurar(manutentor)
End Sub

Private Sub manutentor_BeforeUpdate(Cancel As Integer)
On Error Resume Next
Call Procurar(manutentor)
End Sub

Public Function Procurar(sNome As Integer)
Dim sDate As Date
Dim sOS As Integer
Dim xDate As Date
sDate = Nz(Forms!FLançarHoras!data)
xDate = Nz(DLookup("data", "baixa", "Manutentor = " & Me.manutentor))
sOS = Nz(DLookup("Num_OS", "baixa", "Manutentor= " & Me.manutentor))
sNome = Nz(DLookup("manutentor", "baixa", "Num_OS = " & sOS))

If Not IsNull(manutentor) And Me.num_os <> sOS Then
  If Me.manutentor = sNome And sDate = xDate Then
  If hora_inicio >= Forms!FLançarHoras!hora_inicio And hora_inicio <= Forms!FLançarHoras!hora_final Then
  MsgBox "Este funcionário não poderia estar trabalhando no mesmo dia e dentro do mesmo horário já previamente cadastrado !!!", vbCritical, "Análise"
  Me.Undo
  Else
  Exit Function
  End If
  Else
  MsgBox "Já existe o.s. com este número !!!", vbCritical, "Lançar Horas)"
  Me.Undo
  End If
 
  Else
  Exit Function
  End If
 
End Function


Olá good guys.

Testei inserindo diretamente no formulário, mas mesmo assim não deu certo.
Ele só cai na MsgBox "Já existe o.s. com este número !!!" independente do que eu digito. Basta inserir um número e um manutentor que aparece essa mensagem de erro.

Um detalhe sobre o formulário: é possível um mesmo manutentor executar a mesma ordem várias vezes, desde que não seja no mesmo horário.

Desde já agradeço pela sua ajuda!

Fiz todos os testes possíveis, porém não obtive sucesso. Observei que este teste do código:

Código:

    If Me.manutentor = sNome And sDate = xDate Then

sempre é falso. Independente do que digito. Já lancei mais de 50 registros na tabela para testar, e ele sempre cai no Else, impossibilitando que faça o teste de horas duplicadas.

Olá Vinicius,

Desculpe-me, mas não consegui ter tempo pra nada hoje porque estou com muito serviço pegando aqui na empresa. Me dá um tempo para eu poder pegar no programa, fazer alguns testes e depois eu reporto.

OK, já estou de volta. Testa aí. Copie todo o código e substitua pelo outro.

Código:


Option Compare Database
Option Explicit

Private Sub hora_final_AfterUpdate()
On Error Resume Next
Call Procurar(manutentor)
End Sub

Private Sub manutentor_BeforeUpdate(Cancel As Integer)
On Error Resume Next
Call Procurar(manutentor)
End Sub

Public Function Procurar(sNome As Integer)
Dim sDate As Date
Dim sOS As Integer
Dim xDate As Date
sDate = Nz(Forms!FLançarHoras!data)
xDate = Nz(DLookup("data", "baixa", "Manutentor = " & Me.manutentor))
sOS = Nz(DLookup("Num_OS", "baixa", "Manutentor= " & Me.manutentor))
sNome = Nz(DLookup("manutentor", "baixa", "Num_OS = " & sOS))

If Not IsNull(manutentor) And sDate = xDate Then
  If hora_inicio >= DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) And hora_final <= DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) Then
  MsgBox "Este funcionário não poderia estar trabalhando no mesmo dia e dentro do mesmo horário já previamente cadastrado !!!", vbCritical, "Análise"
  Me.Undo
  Else
  Exit Function
  End If
 
      If hora_inicio >= DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) And hora_final > DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) Then
      MsgBox "Este funcionário não poderia estar trabalhando no mesmo dia e dentro do mesmo horário já previamente cadastrado !!!", vbCritical, "Análise"
      Me.Undo
      ElseIf hora_inicio < DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) And hora_final <= DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) Then
      MsgBox "Este funcionário não poderia estar trabalhando no mesmo dia e dentro do mesmo horário já previamente cadastrado !!!", vbCritical, "Análise"
      Me.Undo
      Else
      Exit Function
      End If
     
      If hora_inicio < DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) And hora_final <= DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) Then
      Exit Function
      ElseIf hora_inicio > DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) And hora_final > DLookup("Hora_final", "baixa", "Manutentor= " & sNome) Then
      Exit Function
      Else
      MsgBox "Este funcionário não poderia estar trabalhando no mesmo dia e dentro do mesmo horário já previamente cadastrado !!!", vbCritical, "Análise"
      Me.Undo
      End If
 
 
 
  Else
  Exit Function
  End If
 
End Function


Olá good guys.

Testei o código e funcionou em partes. Alterei a lógica dele e me trouxe mais resultados, porém descobri um "bug" digamos assim kk e acredito que você com sua experiência conseguirá me ajudar melhor.

Código:



Option Compare Database
Option Explicit

Private Sub hora_final_AfterUpdate()
On Error Resume Next
Call Procurar(manutentor)
End Sub



Public Function Procurar(sNome As Integer)
Dim sDate As Date
Dim sOS As Integer
Dim xDate As Date
sDate = Nz(Forms!FLançarHoras!data)
xDate = Nz(DLookup("data", "baixa", "Manutentor = " & Me.manutentor))
sOS = Nz(DLookup("Num_OS", "baixa", "Manutentor= " & Me.manutentor))
sNome = Nz(DLookup("manutentor", "baixa", "Num_OS = " & sOS))

If Not IsNull(manutentor) And sDate = xDate Then
  If hora_inicio > DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) And hora_final > DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) Then
  Exit Function
  ElseIf hora_inicio < DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) And hora_final < DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) Then
  Exit Function
    Else
    MsgBox "Horas duplicadas! Clique em visualizar duplicadas e verifique.", vbInformation, "PCMSoftware"
    Me.Undo
    End If
     
 
  Else
  Exit Function
  End If
 
End Function


Eu inseri dois If's apenas. Porém neste trecho:

Código:

xDate = Nz(DLookup("data", "baixa", "Manutentor = " & Me.manutentor))

Ele retorna apenas a primeira data encontrada do manutentor, certo? Quando eu realizo um teste lançando um registro do dia 1/8 por exemplo, e tento lançar horas se cruzando nesse dia com o mesmo manutentor, ele funciona perfeitamente, porém se lanço outro registro com o mesmo cara no dia 02/08, ele já não funciona, pois a variável xDate está com o valor 01/08, entende?

Mais uma vez agradeço por sua grande ajuda. No aguardo de uma resposta, abraços!

Código:


 porém se lanço outro registro com o mesmo cara no dia 02/08, ele já não funciona, pois a variável xDate está com o valor 01/08, entende?


Caro Vinícius,

Se você lança outro registro com o mesmo cara no dia seguinte? Não entendi, se é no dia seguinte qual é o problema? Estou fazendo algumas modificações, mas preciso de maior clareza no tocante às condições.

Lanço no outro dia dois horários que se cruzam, ele permite, pois a variável está com a data anterior, como disse

Testa agora Vinícius,

Modifique também as configurações de tabela e formulário:

No formulário:
Entrada de Dados= Não

Na tabela:
data_inicio = Hora Normal
data_fim = Hora Abreviada

Código:


Private Sub Form_Open(Cancel As Integer)
Me.RecordSource = "SELECT * FROM baixa ORDER BY Num_OS"

End Sub

A função também está modificada.

Código:


Public Function Procurar(sNome As Integer)
Dim sDate As Date
Dim sOS As Integer
Dim xDate As Date
sDate = Nz(Forms!FLançarHoras!data)
xDate = Nz(DLast("data", "baixa", "Manutentor = " & Me.manutentor))

sOS = Nz(DLookup("Num_OS", "baixa", "Manutentor= " & Me.manutentor))
sNome = Nz(DLookup("manutentor", "baixa", "Num_OS = " & sOS))

If Not IsNull(manutentor) Then
 If sDate = xDate Then
   If Me.hora_inicio > DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) And Me.hora_final > DLookup("Hora_Final", "baixa", "Manutentor= " & sNome) Then
   Exit Function
   ElseIf hora_inicio < DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) And hora_final < DLookup("Hora_Inicio", "baixa", "Manutentor= " & sNome) Then
   Exit Function
   Else
    MsgBox "Horas duplicadas! Clique em visualizar duplicadas e verifique.", vbInformation, "PCMSoftware"
    Me.Undo
   End If
    
 Else
  
   Exit Function
 End If
End If

End Function

Funcionou perfeitamente !
Obrigado mais uma vez good guys, quando crescer quero ser igual a você kkkk Grande abraço

Olá Vinicius,

Todo o forum agradece o seu retorno. Não esqueça de postar como RESOLVIDO logo abaixo no seu post inicial.

Dê uma curtida também em minha página no Facebook e faça um comentário sobre o meu trabalho. Aguarde o lançamento de meu e-book, TÉCNICAS ESPECIAIS DE ACCESS VBA a ser lançado em breve e não deixe de adquiri-lo. Vou anunciar no meu site e com a permissão do administrador aqui no MaximoAccess.

https://www.facebook.com/EduardoMachado

Visite meu site:

www.goodguyaccessvba.com.br