MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


2 participantes

    alterar codigo

    avatar
    feio134
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 24
    Registrado : 24/02/2013

    alterar codigo Empty alterar codigo

    Mensagem  feio134 7/9/2013, 08:19

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

    Eu saquei da net este código e guardei como função do Excel mas precisava que fosse alterado para o calendário português,
    Muito Agradecido


    Option Explicit

    Function diaUtil(ByVal argData As Date) As 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 Date) As 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(Cool = 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
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8512
    Registrado : 05/11/2009

    alterar codigo Empty Re: alterar codigo

    Mensagem  Alexandre Neves 7/9/2013, 09:02

    Bom dia,
    Procure no fórum. Já se abordou várias vezes os feriados e dias úteis


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    feio134
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 24
    Registrado : 24/02/2013

    alterar codigo Empty Re: alterar codigo

    Mensagem  feio134 8/9/2013, 16:34

    Boa tarde, já efetuei uma pesquisa no Forum e não Encontrei algo que me resolve-se o problema.

    eu vou tentar explicar + - aquilo que pretendo. 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.

    abaixo tenho a lista dos feriados para 2014,e o feriado municipal de paredes que é a zona onde trabalho, assim como os códigos que representam +- aquilo que Pretendo.

    Bom fim de semana e OBRIGADO

    Option Explicit

    Function dataFinalTarefa(argDataInicial As Date, argTempo As String) As 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.
    '
    'Autor: Plinio Mabesi
    'Contato: pliniomabesi@gmail.com
    'Novembro - 2009
    '
    '===========================================================

    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 String) As 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 Double) As 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


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

    [code=vb]
    Option Explicit

    Function diaUtil(ByVal argData As Date) As 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 Date) As 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)
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8512
    Registrado : 05/11/2009

    alterar codigo Empty Re: alterar codigo

    Mensagem  Alexandre Neves 8/9/2013, 18:50

    Boa tarde,
    Afinal, somos de concelhos vizinhos
    1º Confira o feriado de Paredes (16 Julho ou Segunda-feira seguinte ao 3º Domingo de Julho?)
    2º O código do amigo Plínio está a funcionar como pretende(exceptuando o cálculo dos feriados portugueses)?
    Se assim for, coloca-se o feriados portugueses mais o feriado de Paredes (penso que já disponibilizei código de feriados portugueses)


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    feio134
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 24
    Registrado : 24/02/2013

    alterar codigo Empty Re: alterar codigo

    Mensagem  feio134 8/9/2013, 22:19

    Boa noite! Acerca do código do Plínio eu so sei que no formulário de access ele esta a funcionar. no Excel da uma diferença, eu calculo que seja devido ao calendário mas não sei porque como tenho vindo a dizer sou muito maçarico. dai eu precisar que você me faça e teste o Código OBRIGADO e Boa noite:
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8512
    Registrado : 05/11/2009

    alterar codigo Empty Re: alterar codigo

    Mensagem  Alexandre Neves 8/9/2013, 22:46

    Este fórum é de Access, mas a função no Excel funcionará semelhante


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    feio134
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 24
    Registrado : 24/02/2013

    alterar codigo Empty Re: alterar codigo

    Mensagem  feio134 9/9/2013, 09:17

    Bom dia! eu sei que funciona não sei é alterar para os feriados portugueses já tentei e não consigo.
    Acerca da vizinhança dos concelhos ainda somos mais vizinhos, porque eu resido em Valongo.
    avatar
    feio134
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 24
    Registrado : 24/02/2013

    alterar codigo Empty Alterei o código mas dá valores errados

    Mensagem  feio134 10/9/2013, 10:34

    Bom dia! acho que consegui alterar o código no que se refere ao dias feriados, mas agora surgiu outro problema, a função tá a dar valores errados e eu não consegui corrigir depois de muito tentar, dá para dar uma ultima ajuda e ver o que se passa? Vou anexar um pequeno ficheiro a exemplificar o que pretendo.
    Desde já as minhas desculpas pela ignorância e MUITO OBRIGADO. abs.
    Anexos
    alterar codigo AttachmentTeste.xlsx
    Você não tem permissão para fazer download dos arquivos anexados.
    (10 Kb) Baixado 5 vez(es)
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8512
    Registrado : 05/11/2009

    alterar codigo Empty Re: alterar codigo

    Mensagem  Alexandre Neves 13/9/2013, 18:39

    Boa tarde,
    O fórum é para Access. Apesar da função ser em VBA, no Excel funcionará


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    Conteúdo patrocinado


    alterar codigo Empty Re: alterar codigo

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 6/12/2024, 16:44