Incluir Pausa de Almoço e limitar dia util a 8:00 horas

[José luis leal]

Boa tarde! Muito urgente precisava que alguém me resolve-se um problema que faz tempo estou a tentar, mas não consigo.

no código vba abaixo tinha necessidade de descontar uma pausa para almoço e reduzir um dia útil a 8 horas.

Desde já um muito obrigado ao fórum em particular a quem se dispuser a ajudar este pobre autodidata maçarico.

Option Compare Database
Option Explicit
Public Function DTS(dtInicio As Date, dtFim As Date, Optional HojeTb As Boolean = False, Optional UltTb As Boolean = False) As Integer
'....................................................................
' Nome:	 DTS
' Entradas: dtInicio As Date
'		   dtFim As Date
'		   HojeTb As Boolean
'		   UltTb As Boolean
' Saída:    Integer
' Autor:    Arvin Meyer
' Data:	 Maio 5,2002
' Comentário: Aceita duas datas e devolve o número de dias úteis
'			 entre elas. Note-se que esta função considera os feriados
'			 do período. Ela exige a existência de uma tabela chamada
'			 tblFeriados com um campo, no formato data, chamado FerData.
'			 Se HojeTb = True, a data inicial também será considerada.
'			 Se UltTb = true, a data final também será considerada.
'....................................................................
On Error GoTo Err_DTS
Dim intCount As Integer
Dim rst As DAO.Recordset
Dim DB As DAO.Database
   Set DB = CurrentDb
   Set rst = DB.OpenRecordset("SELECT [FerData] FROM tblFeriados", dbOpenSnapshot)
   If Not HojeTb Then
    dtInicio = dtInicio + 1
   End If
' Se desejar contar a data de início, passe True em HojeTb
   intCount = 0
   If UltTb Then
    Do While dtInicio <= dtFim
	    rst.FindFirst "[FerData] = #" & Format(dtInicio, "mm/dd/yyyy") & "#"
	    If Weekday(dtInicio) <> vbSunday And Weekday(dtInicio) <> vbSaturday Then
		    If rst.NoMatch Then intCount = intCount + 1
	    End If
	    dtInicio = dtInicio + 1
    Loop
   Else
    Do While dtInicio < dtFim
	    rst.FindFirst "[FerData] = #" & Format(dtInicio, "mm/dd/yyyy") & "#"
	    If Weekday(dtInicio) <> vbSunday And Weekday(dtInicio) <> vbSaturday Then
		    If rst.NoMatch Then intCount = intCount + 1
	    End If
	    dtInicio = dtInicio + 1
    Loop
   End If
   DTS = intCount
Exit_DTS:
Exit Function
Err_DTS:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_DTS
End Select
End Function
'*********** Code End **************

[tiago.f]

Olá,

a função que partilhas, segundo a documentação, "Aceita duas datas e devolve o número de dias úteis.

Assim, não percebo a tua pergunta/pedido: não há qualquer cálculo de horas nesta função.

Cumprimentos

EDIT: já agora esta função ficaria muito mais eficiente se evitasses filtrar o Recordset uma vez por cada dia entre a duas datas.

Qualquer coisa assim:

Option Compare Database
Option Explicit
Public Function DTS(dtInicio As Date, dtFim As Date, Optional HojeTb As Boolean = False, Optional UltTb As Boolean = False) As Integer
   '....................................................................
   ' Nome:  DTS
   ' Entradas: dtInicio As Date
   '                  dtFim As Date
   '                  HojeTb As Boolean
   '                  UltTb As Boolean
   ' Saída:    Integer
   ' Autor:    Arvin Meyer
   ' Data:  Maio 5,2002
   ' Comentário: Aceita duas datas e devolve o número de dias úteis
   '                        entre elas. Note-se que esta função considera os feriados
   '                        do período. Ela exige a existência de uma tabela chamada
   '                        tblFeriados com um campo, no formato data, chamado FerData.
   '                        Se HojeTb = True, a data inicial também será considerada.
   '                        Se UltTb = true, a data final também será considerada.
   '....................................................................
   On Error GoTo Err_DTS

   Dim rst As DAO.Recordset
   Dim DB As DAO.Database
   Dim numberOfRows as integer
   Dim numberOfWorkingDays as integer

   If Not HojeTb Then
       dtInicio = dateadd("d", -1, dtInicio)
   End If

   If Not UltTb Then
       dtFim = dateadd("d", -1, dtFim)
   End If

   Set DB = CurrentDb
   Set rst = DB.OpenRecordset("SELECT [FerData] FROM tblFeriados WHERE [FerData] BETWEEN #" & Format(dtInicio, "mm/dd/yyyy") & "# AND #" & Format(dtFim, "mm/dd/yyyy") & "#", dbOpenSnapshot)

   numberOfRows = DB.RecordCount
   numberOfWorkingDays = DateDiff("w", dtInicio, dtFim)

   DTS = numberOfWorkingDays-numberOfRows

   Exit_DTS:
   Exit Function
   Err_DTS:
   Select Case Err
   Case Else
   MsgBox Err.Description
   Resume Exit_DTS
   End Select
End Function
'*********** Code End **************

Edited January 15, 2016 at 04:46 PM by tiago.f

[José luis leal]

Boa noite aqui vai o link para o ficheiro no qual eu estou a tentar alterar mas não estou a conseguir aquilo que eu presisava era fazer com que o resultado entre a hora inicial e a hora final não contemplasse o período de descanso para o almoço.

desculpe a minha ignorância mas não estou certo se aquilo que estou pedindo será ou não possível.

mas tenho uma necessidade tremenda de conseguir algo que faça o seguinte:

Dar o resultado entre duas datas descontando fins de semana e feriados e com o seguinte Horário

Entrada 8:00

Saída para almoço 12:30

Reentrada 13:30

Saída 18:00

Link Para o ficheiro: https://www.dropbox.com/s/wzhxjihd23z0s24/DiasUteisTrabalhados.accdb?dl=0

Muito obrigado pela prontidão da resposta, e desculpe qualquer coisa mas sou um autodidata e não é fácil.

um grande bem aja e bom fim de semana

Edited January 16, 2016 at 02:22 AM by José luis leal

[tiago.f]

Olá José,

olhando para o ficheiro access, não encontro nenhum calculo de horas.

Podes explicar onde está o cálculo de horas que queres ver alterado, de modo a que exclua o período de almoço?

...e estamos cá para ajudar no que conseguirmos.

Cumprimentos

[José luis leal]

Boa tarde!

Aquilo que eu pretendo é incluir no código vba que está preparado para ao ser introduzida uma hora/data inicial e uma data/hora final ele reporta a duração da tarefa em Horas/minutos,descontando fins de semana,feriados.

Eu pretendia que esse código fosse alterado pare serem somente contabilizadas as horas do período laboral que referi acima descontando o tal período de amoço