Notifications
Clear all

Fazer com que código funcione no Excel

4 Posts
3 Usuários
0 Reactions
1,070 Visualizações
(@feio134)
Posts: 10
Active Member
Topic starter
 

A todo o Pessoal do do Fórum um bom dia, um bom fim de semana Prolongado!

O que me leva a novamente estar a chatear-vos é o seguinte, tenho um código que está num ficheiro access e que precisava colocar a funcionar no Excel.

Dava para dar uma ajuda? desde já um muito obrigado e um bom fim de semana de Páscoa.

Option Explicit
Public Function DuracaoTarefa(dtInicio As Date, dtFim As Date) As Integer
'....................................................................
' Nome:  DuracaoTarefa
' Entradas: dtInicio As Date
'                dtFim As Date
' Saída: Integer (Minutos)
' Autor: Arvin Meyer
' Data:  Maio 5,2002
' Comentário:
' Aceita duas datas e devolve o número de minutos entre elas. Tem conta
' o horário definido na tabela "tblHorario".
' O horário é definido em 3 períodos. O inicio/fim de cada período é
' definido com o número de minutos desde as 0 horas.
' 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. Os Domingos também são ignorados.
'....................................................................
On Error GoTo Err_DuracaoTarefa
Dim intCount As Integer
Dim DB As DAO.Database
Dim rst As DAO.Recordset
Dim rst_horario As DAO.Recordset
Dim TotalMinutos
Dim TotalMinutosFora
Dim MinutoAtual
Dim P1I, P1F
Dim P2I, P2F
Dim P3I, P3F
Dim DiaAtual As Date
Dim MinutoInicial As Integer
Dim MinutoFinal As Integer
TotalMinutos = 0

DiaAtual = dtInicio
Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [FerData] FROM tblFeriados", dbOpenSnapshot)
intCount = 0
         Do While DiaAtual < dtFim
                 rst.FindFirst "[FerData] = #" & Format(DiaAtual, "mm/dd/yyyy") & "#"
                 If Weekday(DiaAtual) <> vbSunday Then '' And Weekday(dtInicio) <> vbSaturday Then
                         If rst.NoMatch Then
                                 'Se chegou aqui é porque é dia útil e não é feriado
                                 Set rst_horario = DB.OpenRecordset("SELECT * FROM tblHorario where HorarioDiaSemanaNum = " & Weekday(DiaAtual), dbOpenSnapshot)
                                 P1I = rst_horario("HorarioP1Inicio")
                                 P1F = rst_horario("HorarioP1Fim")
                                 P2I = rst_horario("HorarioP2Inicio")
                                 P2F = rst_horario("HorarioP2Fim")
                                 P3I = rst_horario("HorarioP3Inicio")
                                 P3F = rst_horario("HorarioP3Fim")
                                
                                 If Day(dtFim) = Day(dtInicio) And dtFim - dtInicio < 24 Then ' Inicia e termina no mesmo dia
                                         MinutoInicial = Hour(dtInicio) * 60 + Minute(dtInicio)
                                         MinutoFinal = Hour(dtFim) * 60 + Minute(dtFim)
                                         For MinutoAtual = MinutoInicial To MinutoFinal
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                                 ElseIf DiaAtual = dtInicio Then 'Tratamento 1º dia
                                         MinutoInicial = Hour(dtInicio) * 60 + Minute(dtInicio)
                                         MinutoFinal = 1440
                                         For MinutoAtual = MinutoInicial To MinutoFinal - 1
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                        
                                 ElseIf Day(DiaAtual) = Day(dtFim) And dtFim - DiaAtual < 24 Then 'Tratamento último dia
                                                                        
                                         MinutoInicial = 0
                                         MinutoFinal = Hour(dtFim) * 60 + Minute(dtFim)
                                         For MinutoAtual = MinutoInicial To MinutoFinal - 1
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                                 ElseIf DiaAtual > dtInicio And DiaAtual < dtFim Then
                                         For MinutoAtual = 0 To 1440
                                                 If (MinutoAtual >= P1I And MinutoAtual < P1F) Then      'Periodo 1
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P2I And MinutoAtual < P2F) Then 'Periodo 2
                                                         TotalMinutos = TotalMinutos + 1
                                                 ElseIf (MinutoAtual >= P3I And MinutoAtual < P3F) Then 'Periodo 3
                                                         TotalMinutos = TotalMinutos + 1
                                                 Else
                                                         TotalMinutosFora = TotalMinutosFora + 1
                                                 End If
                                         Next
                                 Else
                                 End If
                                 'intCount = intCount + 1
                         Else
                         End If
                 End If
                 DiaAtual = DiaAtual + 1
         Loop
        
DuracaoTarefa = TotalMinutos

Exit_DuracaoTarefa:
Exit Function
Err_DuracaoTarefa:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_DuracaoTarefa
End Select
End Function
 
Postado : 25/03/2016 12:39 pm
(@mprudencio)
Posts: 2749
Famed Member
 

Se ao inves de pedir para adaptar vc disser o que o codigo faz e disponibilizar um arquivo modelo provavelmente a solução sera mais rapida.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 25/03/2016 3:19 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Voce tem acesso a esse arquivo access *(em português do Brasil , não existe a palavra ficheiro) ?
Se tiver o acesso, por favor, coloque todo o conteúdo da tabela tblFeriados num arquivo de Excel, e mande pra gente, só pra eu poder ver quais são os feriados e entender melhor como eu posso eliminar o access do seu código.
Digo isso, pois parece que a única dependência de Access no seu código é pra buscar a lista de feriados. Então, se a lista estiver no Excel, e trocarmos a busca dos feriados pra pegar no Excel, o código funcionará perfeitamente.

Ok, falei falei falei, no fim:
Publique por favor, seguindo a sugestão do Marcelo Prudencio, um arquivo de Excel mas especificamente, coloque nesse modelo uma planilha com um Ctrl+C/Ctrl+V direto da tblFeriado que está no access

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 25/03/2016 7:30 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Ora pois, você tem vários tópicos na net, todos solicitando para alterar esta function para contar 8 horas, então acredito que o arquivo access que se refere é deste tópico :

- - - - -
[Resolvido] Incluir Pausa de Almoço e limitar dia util a 8:00 horas
http://www.portugal-a-programar.pt/topi ... 800-horas/
Link arquivo dropbox : https://www.dropbox.com/s/wzhxjihd23z0s ... accdb?dl=0

Com a alteração solicitada na rotina e a principio com a solução :
http://www.portugal-a-programar.pt/topi ... ar-codigo/

Faça como o Marcelo e o fernando disseram, monte tudo em um arquivo excel e envie, para facilitar, abra o arquivo no access e exporte as tabelas.
Só não vou mexer nisso agora pois estou de saida e não sei que horas volto.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 26/03/2016 9:42 am