Fórum Excel Bácico, Avançado e Vba
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.
Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  Últimas imagensÚltimas imagens  ProcurarProcurar  RegistarRegistar  Entrar  

 

  FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL

Ir para baixo 
2 participantes
AutorMensagem
feio134




Mensagens : 10
Data de inscrição : 09/09/2013

 FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL Empty
MensagemAssunto: FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL    FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL EmptySex 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]
Ir para o topo Ir para baixo
alexandrevba

alexandrevba


Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

 FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL Empty
MensagemAssunto: Re: FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL    FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL EmptySeg 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
Ir para o topo Ir para baixo
 
FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL
Ir para o topo 
Página 1 de 1
 Tópicos semelhantes
-
» Criar código para fazer consulta em formulário
» Código VBA Excel P/ Access
» Dúvidas código
» Visualizar outra planilha de Excel enquanto Outra esta Oculta por Código
»  VBA no Excel 2010 acessa Excel 2003

Permissões neste sub-fórumNão podes responder a tópicos
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: