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  

 

 alterar o codigo

Ir para baixo 
AutorMensagem
feio134




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

alterar o codigo Empty
MensagemAssunto: alterar o codigo   alterar o codigo EmptySeg Set 09, 2013 6:01 pm

Boa tarde, Será que alguém me pode ajudar na resolução de um problema que de seguida irei apresentar?

Eu saquei da net estes códigos e guardei como função do Excel mas precisava que fosse alterado para o calendário português,
Muito Agradecido abaixo tenho a lista dos feriados para 2014,e o feriado municipal de paredes que é a zona onde trabalho, espero que seja suficiente. aproveito para chatear mais um pouco, aumentando o pedido com o seguinte, será possível Alguém colocar no código isto que vou tentar explicar o melhor possível ?
Eu tenho uma folha de calculo em que controlo todas as vertentes que entendo como necessárias para controlar a produção de uma Pequena fabrica de móveis, e o que eu pretendo com o código que lhe estou a pedir e fazer o seguinte; Tendo eu uma célula onde insiro a data e hora do inicio da Ordem de fabricação, e noutra célula é apresentada a soma do período que demora a ser produzida, o que eu preciso é que o código me apresente notra célula a data e hora para o fim da ordem de produção excluindo os Fim de semana, os feriados e as respetivas pausas de laboração,que são as seguintes: Entrada ás 08:00, Café da manha das 10:00 ás 10:10, período de almoço das 12:30 ás 14:00, café da tarde das 16:00 ás 16:10, saída às 18:00. Será que Alguém me puderia ajudar Fazendo um código que me resolve-se este problema ? ficaria muito Grato.

Bom fim de semana e OBRIGADO

Código (Visual Basic):
Option Explicit

Function dataFinalTarefa(argDataInicial As Date, argTempo As StringAs 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.
'
'
'===========================================================

Dim horaInicial As Double, horaFinal As Double
Dim inicioExpediente As Double, fimExpediente As Double
Dim inicioCafe As Double, fimCafe As Double
Dim inicioAlmoco As Double, fimAlmoco As Double
Dim TempoTarefa As Double
Dim totalExpediente As Double
Dim totalCafe As Double
Dim totalAlmoco As Double
Dim restante As Double
Dim numeroDias As Integer
Dim teste As Double
Dim i As Integer

'Configuração dos dados iniciais. Para personalizar
'basta alterar os valores a serem utilizados.
inicioExpediente = converteHoraDouble("08:00")
inicioCafe = converteHoraDouble("10:00")
fimCafe = converteHoraDouble("10:10")
inicioAlmoco = converteHoraDouble("12:30")
fimAlmoco = converteHoraDouble("14:00")
fimExpediente = converteHoraDouble("18:30")

TempoTarefa = converteHoraDouble(argTempo)

totalCafe = fimCafe - inicioCafe
totalAlmoco = fimAlmoco - inicioAlmoco
totalExpediente = fimExpediente - inicioExpediente - totalAlmoco - totalCafe

horaInicial = converteHoraDouble(Format(Hour(argDataInicial), "00") & ":" & Format(Minute(argDataInicial), "00"))

numeroDias = ((horaInicial + TempoTarefa - inicioExpediente) * 10000) \ ((totalExpediente + 0.0001) * 10000)

If horaInicial < inicioExpediente Or horaInicial > fimExpediente Or (horaInicial >= inicioCafe And horaInicial < fimCafe) Or (horaInicial >= inicioAlmoco And horaInicial < fimAlmoco) Then
dataFinalTarefa = "Hora inicial inválida!"
Exit Function
End If

dataFinalTarefa = argDataInicial

For i = 1 To numeroDias

Do
dataFinalTarefa = dataFinalTarefa + 1
Loop Until diaUtil(dataFinalTarefa)

Next i

horaFinal = horaInicial + TempoTarefa

If horaInicial < inicioCafe And horaFinal > inicioCafe Then
horaFinal = horaFinal + totalCafe
End If

If 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 If

If horaFinal > inicioCafe And numeroDias > 0 Then

horaFinal = horaFinal + totalCafe

If horaFinal > inicioAlmoco Then

horaFinal = horaFinal + totalAlmoco

If horaFinal > fimExpediente Then
restante = horaFinal - fimExpediente
horaFinal = inicioExpediente + restante
Do
dataFinalTarefa = dataFinalTarefa + 1
Loop Until diaUtil(dataFinalTarefa)
End If

End If

ElseIf horaFinal = inicioExpediente Then
horaFinal = fimExpediente
End If

dataFinalTarefa = CDate(Day(dataFinalTarefa) & "/" & Month(dataFinalTarefa) & "/" & Year(dataFinalTarefa) & _
" " & Fix(horaFinal) & ":" & Round((horaFinal - Fix(horaFinal)) * 60))

End Function

Function converteHoraDouble(argHora As StringAs Double

Dim lngHora As Long, dblMinuto As Double

lngHora = CInt(Left(argHora, 2))
dblMinuto = CDbl(Right(argHora, 2))
dblMinuto = (dblMinuto * 100) / 60

converteHoraDouble = lngHora + dblMinuto / 100

End Function

Function converteHoraTexto(argHora As DoubleAs String

Dim intHora As Integer, intMinuto As Integer

intHora = Fix(argHora)
intMinuto = (argHora - intHora) * 100
intMinuto = (intMinuto * 60) / 100

converteHoraTexto = Format(intHora, "00") & ":" & Format(intMinuto, "00")

End Function



-------------------------------------------------------------------------------------------------------------------------------------------------------------------

Código (Visual Basic):
Option Explicit

Function diaUtil(ByVal argData As DateAs Boolean

        If Weekday(argData) = vbSunday Or Weekday(argData) = vbSaturday Then
                diaUtil = False
        Else
                If feriado(argData) Then
                        diaUtil = False
                Else
                        diaUtil = True
                End If
        End If

End Function

Function feriado(ByVal argData As DateAs Boolean
        On Error GoTo Err_Feriado
'===========================================================
'Esta função tem como objetivo verificar se a data inserida
'é um feriado brasileiro, retornando True em caso positivo.
'

'
' *** Função de livre uso se mantidos os créditos ***
'
'===========================================================

        If IsNull(argData) Then Exit Function

        Dim a%, b%, c%, d%, e%, f%, g%, h%, i%, j%, k%, l%, m%, p%, q%
        Dim intAno As Integer, intConta As Integer
        Dim Pascoa As Date, varData(12) As Date

        argData = Day(argData) & "/" & Month(argData) & "/" & Year(argData)

        feriado = False
        intAno = Year(CDate(argData))

'   Calcula a data da Páscoa
        If intAno >= 1583 Then  ' Jean Baptiste Joseph Delambre (1749-1822)
                a = intAno Mod 19
                b = Fix(intAno / 100)
                c = intAno Mod 100
                d = Fix(b / 4)
                e = b Mod 4
                f = Fix((b + 8)/ 25)
                g = Fix((b - f + 1) / 3)
                h = (19 * a + b - d - g + 15) Mod 30
                i = Fix(c / 4)
                k = c Mod 4
                l = (32 + 2 * e + 2 * i - h - k) Mod 7
                m = Fix((a + 11 * h + 22 * l) / 451)
                p = Fix((h + l - 7 * m + 114) / 31)
                q = (h + l - 7 * m + 114) Mod 31
                Pascoa = DateSerial(intAno, p, q + 1)
        Else  ' Calendário Juliano
                a = intAno Mod 4
                b = intAno Mod 7
                c = intAno Mod 19
                d = (19 * c + 15) Mod 30
                e = (2 * a + 4 * b - d + 34) Mod 7
                f = Fix((d + e + 114) / 31)
                g = (d + e + 114) Mod 31
                Pascoa = DateSerial(intAno, f, g + 1)
        End If

'   Define feriados móveis
        varData(0) = Pascoa - 48   ' Segunda-feira de Carnaval
        varData(1) = Pascoa - 47   ' Terça-feira de Carnaval
        varData(2) = Pascoa - 2 ' Paixão de Cristo
        varData(3) = Pascoa             ' Páscoa
        varData(4) = Pascoa + 60   ' Corpus Christi

'   Feriados Nacionais (lei 10.607/2002)
        varData(5) = CDate("01/01/" & intAno)   ' Confraternização Universal
        varData(6) = CDate("21/04/" & intAno)   ' Tiradentes
        varData(7) = CDate("01/05/" & intAno)   ' Dia do trabalho
        varData(8) = CDate("07/09/" & intAno)   ' Independência
        varData(9) = CDate("12/10/" & intAno)   ' Padroeira do Brasil
        varData(10) = CDate("02/11/" & intAno)  ' Finados
        varData(11) = CDate("15/11/" & intAno)  ' Proclamação da República
        varData(12) = CDate("25/12/" & intAno)  ' Natal
        '... Insira aqui os feriados regionais e altere o tamanho da matriz


'   Verifica data
        For intConta = 0 To UBound(varData)
                If CDate(argData) = varData(intConta) Then
                        feriado = True
                        Exit Function
                End If
        Next

Sair:
        Exit Function

Err_Feriado:
        MsgBox "Erro: " & Err.Number & " - " & Err.Description
        Resume Sair

End Function



Feriados 2014 em Portugal
Janeiro
1 Janeiro (4º feira) Dia de Ano Novo
Março
4 Março (3ª feira) Carnaval
Abril
18 Abril (6ª feira) Sexta-Feira Santa
20 Abril (domingo) Páscoa
25 Abril (6ª feira) Dia da Liberdade/25 de Abril
Maio
1 Maio (5ª feira) Dia do Trabalhador
Junho
10 Junho (3ª feira) Dia de Portugal
Agosto
15 Agosto (6ª feira) Assunção de Nossa Senhora
Dezembro
8 Dezembro (2ª feira) Dia da Imaculada Conceição
25 Dezembro (5ª feira) Natal


Paredes - 16 de julho (3ª feira) 
Ir para o topo Ir para baixo
 
alterar o codigo
Ir para o topo 
Página 1 de 1
 Tópicos semelhantes
-
» PROBLEMAS NO BOTÃO ALTERAR CADASTRO
» Alterar a faixa de referencia em um Nome utilizando VBA
» Alterar Macro atravez de uma célula [Resolvido]
» VBA para cadastrar excluir e alterar usuário
» Alterar data quando modifica planilha

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: