Jump to content
José luis leal

[Resolvido] Adaptar código vba

Recommended Posts

José luis leal

Boa noite!

O que me traz novamente ao fórum é como não deixaria de ser devido a minha situação de maçarico autodidata é novamente um

pedido de ajuda, que vou tentar descrever o melhor que sei desde já um pedido de desculpa se não for bem explicito.

tenho um código vba a funcionar em Excel que colocarei abaixo, precisava de o adaptar a uma base de dados access.

O Código traduz a diferença entre datas contemplando os fim de semanas e os feriados incluindo o municipal e também desconta os períodos não laborais tendo em conta as pausas para almoços.

Será possível polo a funcionar ou fazer um novo que funcione no access? Agradecido.

Option Explicit

Function dataFinalTarefa(argDataInicial As Date, argTempo As String) As Variant
'============================================================================
'Função que calcula uma data e hora final a partir de uma data e hora inicial
'somando-se uma quantidade de horas referentes a uma tarefa.
'Autor: Plinio Mabesi - Contato: pliniomabesi@gmail.com
'Novembro - 2009 --> Alteração:= Setembro - 2013 - Reinaldo
'============================================================================
Dim horaInicial As Double, horaFinal As Double
Dim inicioExpediente As Double, fimExpediente As Double
Dim inicioCafe As Double, fimCafe As Double
Dim inicioCafeTarde As Double, fimCafeTarde As Double
Dim inicioAlmoco As Double, fimAlmoco As Double
Dim TempoTarefa As Double, totalExpediente As Double
Dim totalCafe As Double, totalCafeTarde As Double
Dim totalAlmoco As Double, Restante As Double
Dim numeroDias As Integer, i As Integer'Configuração dos dados iniciais. Para personalizar basta alterar os valores a serem utilizados.
inicioExpediente = converteHoraDouble(Format(Sheets("Feriados").Cells(6, 9), "hh:mm"))
inicioCafe = converteHoraDouble(Format(Sheets("Feriados").Cells(7, 9), "hh:mm"))
fimCafe = converteHoraDouble(Format(Sheets("Feriados").Cells(7, 10), "hh:mm"))
inicioCafeTarde = converteHoraDouble(Format(Sheets("Feriados").Cells(9, 9), "hh:mm"))
fimCafeTarde = converteHoraDouble(Format(Sheets("Feriados").Cells(9, 10), "hh:mm"))
inicioAlmoco = converteHoraDouble(Format(Sheets("Feriados").Cells(8, 9), "hh:mm"))
fimAlmoco = converteHoraDouble(Format(Sheets("Feriados").Cells(8, 10), "hh:mm"))
fimExpediente = converteHoraDouble(Format(Sheets("Feriados").Cells(6, 10), "hh:mm"))
TempoTarefa = converteHoraDouble(argTempo)
totalCafe = fimCafe - inicioCafe
totalCafeTarde = fimCafeTarde - inicioCafeTarde
totalAlmoco = fimAlmoco - inicioAlmoco
totalExpediente = fimExpediente - inicioExpediente - totalAlmoco - totalCafe - totalCafeTarde
horaInicial = converteHoraDouble(Format(Hour(argDataInicial), "00") & ":" & Format(Minute(argDataInicial), "00"))
If horaInicial + TempoTarefa <= fimExpediente Then
numeroDias = 0
Else
numeroDias = ((horaInicial + TempoTarefa - inicioExpediente) * 10000) \ ((totalExpediente + 0.0001) * 10000)
End If
If horaInicial < inicioExpediente Or horaInicial > fimExpediente Or (horaInicial >= inicioCafe And horaInicial < fimCafe) _
Or (horaInicial >= inicioCafeTarde And horaInicial < fimCafeTarde) Or (horaInicial >= inicioAlmoco And horaInicial < fimAlmoco) Then
dataFinalTarefa = "Hora inicial inválida!"
Exit Function
End If
dataFinalTarefa = argDataInicialFor i = 1 To numeroDias
Do
dataFinalTarefa = dataFinalTarefa + 1
Loop Until ÉDiaUtil(dataFinalTarefa)Next i
horaFinal = horaInicial + TempoTarefaIf horaInicial < inicioCafe And horaFinal > inicioCafe Then
horaFinal = horaFinal + totalCafe
End If
If horaInicial < inicioCafeTarde And horaFinal > inicioCafeTarde Then
horaFinal = horaFinal + totalCafeTarde
End IfIf horaInicial < inicioAlmoco And horaFinal > inicioAlmoco Then
horaFinal = horaFinal + totalAlmoco
End If
If horaFinal > fimExpediente Then
horaFinal = horaFinal - fimExpediente
horaFinal = Round(horaFinal, 3) - Round(((horaFinal * 1000) \ (totalExpediente * 1000)) * totalExpediente, 3)
horaFinal = horaFinal + inicioExpediente
End IfIf horaFinal > inicioCafe And numeroDias > 0 Then
horaFinal = horaFinal + totalCafe
If horaFinal > inicioAlmoco Then
 horaFinal = horaFinal + totalAlmoco
	 If horaFinal > inicioCafeTarde Then
		 horaFinal = horaFinal + totalCafeTarde
		 If horaFinal > fimExpediente Then
			 Restante = horaFinal - fimExpediente
			 horaFinal = inicioExpediente + Restante
			 Do
			 dataFinalTarefa = dataFinalTarefa + 1
			 Loop Until ÉDiaUtil(dataFinalTarefa)
		 End If
	 End If
End If
ElseIf horaFinal = inicioExpediente Then
horaFinal = fimExpediente
End IfdataFinalTarefa = CDate(Day(dataFinalTarefa) & "/" & Month(dataFinalTarefa) & "/" & Year(dataFinalTarefa) & _
" " & Fix(horaFinal) & ":" & Round((horaFinal - Fix(horaFinal)) * 60))
End FunctionFunction converteHoraDouble(argHora As String) As Double
Dim lngHora As Long, dblMinuto As Double
Dim nPts As Long
nPts = InStr(1, argHora, ":") - 1
lngHora = CInt(Left(argHora, nPts))
dblMinuto = CDbl(Right(argHora, 2))
dblMinuto = (dblMinuto * 100) / 60converteHoraDouble = lngHora + dblMinuto / 100
End FunctionFunction converteHoraTexto(argHora As Double) As String
Dim intHora As Integer, intMinuto As IntegerintHora = Fix(argHora)
intMinuto = (argHora - intHora) * 100
intMinuto = (intMinuto * 60) / 100
converteHoraTexto = Format(intHora, "00") & ":" & Format(intMinuto, "00")End Function
Function ÉFeriado(sbDia) As Boolean
Dim n As Long, kCont As Long, x As Long
Dim stFer() As String
n = Application.WorksheetFunction.CountA(Sheets("Feriados").Range("A4:A100"))
ReDim stFer(n)
For x = 1 To n
stFer(x) = Day(Sheets("Feriados").Range("B" & x + 3)) & "/" & Month(Sheets("Feriados").Range("B" & x + 3))
Next x
For kCont = 1 To n
If Day(sbDia) & "/" & Month(sbDia) = stFer(kCont) Then
	 ÉFeriado = True
	 Exit Function
 End If
Next kCont

End Function
Function ÉFimSemana(ByVal Data As Date) As Boolean
'vbMonday "determina" inicio da semana Segunda-feira (1) e término no Domingo (7)
If Weekday(Data, vbMonday) < 6 Then
 ÉFimSemana = False
Else
 ÉFimSemana = True
End If
End Function'<b>Vamos agora consolidar as funções e criar uma nova função chamada Édiaùtil</b>
Function ÉDiaUtil(ByVal Data As Date) As Boolean
If Not ÉFeriado(Data) And Not ÉFimSemana(Data) Then
 ÉDiaUtil = True
Else
 ÉDiaUtil = False
End If
End Function'<b> Agora vamos criar uma função para contar quantos dias úteis existe entre duas datas</b>
Function DiasUteisEntreDatas(DataInicial As Date, DataFinal As Date) As Double
Dim Idatas As Date, i As Double
i = 0
For Idatas = DataInicial To DataFinal
 If ÉDiaUtil(Idatas) Then i = i + 1
Next
DiasUteisEntreDatas = i
End Function

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.