feio134
Mensagens : 10 Data de inscrição : 09/09/2013
| Assunto: FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL Sex Mar 25, 2016 9:32 pm | |
| 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. - Código:
-
[code]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[/code] | |
|
alexandrevba
Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES
| Assunto: Re: FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL Seg maio 30, 2016 8:15 pm | |
| Boa tarde!!!
Você terá que substituir os objetos nativos do access para o excel (table por sheet etc) e os campos dentro do userform.
Att | |
|