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  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

  FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
feio134



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

MensagemAssunto: 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]
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



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

MensagemAssunto: 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
Voltar ao Topo Ir em baixo
Ver perfil do usuário
 
FAZER COM QUE CÓDIGO FUNCIONE NO EXCEL
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» Fazer GM executar código externo - Consegui - Porém outros problemas...
» Como fazer um código de texto que muda diariamente?
» [AJUDA] Como fazer um cronômetro de contagem regressiva?
» Problemas com o código size, o que fazer ?
» Como fazer movimento tipo Snake

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: