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


    Calendario de Eventos (Adaptado com feriados brasileiros)

    Gilberto Rocha
    Gilberto Rocha
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1027
    Registrado : 21/01/2010

    Calendario de Eventos (Adaptado com feriados brasileiros) Empty Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Gilberto Rocha Sáb 10 Dez - 0:17

    Exemplo postado pelo JPaulo, adaptado para deixar domingos e feriados em vermelho.


    'Neste exemplo troque a função Cal(m, Y) por essa abaixo, ou somente acrescente a parte em vermelho

    http://maximoaccess.forumeiros.com/t5481-calendario-de-eventos


    Function Cal(m, Y)
    Dim a
    Dim DayOne
    Dim gOffset
    Dim f As Form
    Dim h As Form
    Dim workdate
    Dim myDay As Integer
    Dim diaDomingo As String
    myDay = Format(Date, "dd")
    'Adicionei

    Set f = Forms!frmCalender

    f!month.SetFocus
    m = f!month
    Y = f!year

    For a = 1 To 37
    f("Day" & a + gOffset).Visible = False
    f("Text" & a + gOffset).Visible = False
    f("horario" & a + gOffset).Visible = False
    f("date" & a + gOffset) = Null
    f("day" & a + gOffset) = Null
    'Removido linha abaixo
    'f("horario" & a + gOffset) = Null

    Next

    DayOne = DateValue("1/" & m & "/" & Y)
    ' DayOne = DateValue(m & "/1/" & Y)
    workdate = DayOne
    gOffset = Weekday(DayOne) - 1

    For a = 1 To LenMonth(DayOne)
    f("Day" & a + gOffset).Visible = True
    f("Text" & a + gOffset).Visible = True
    'f("horario" & a + gOffset).Visible = True
    f("date" & a + gOffset) = workdate
    workdate = workdate + 1
    f("day" & a + gOffset) = a
    If a = myDay Then
    f("Text" & a + gOffset).BackColor = vbGreen 'RGB(255, 236, 139)
    f("Day" & a + gOffset).BackColor = vbGreen 'RGB(255, 236, 139)
    Else
    f("Text" & a + gOffset).BackColor = vbWhite 'RGB(198, 226, 255)
    f("Day" & a + gOffset).BackColor = vbWhite 'RGB(198, 226, 255)
    End If

    'Feriados em vermelho
    If FeriadoBrasileiro(Format(workdate - 1, "dd-mm-yyyy"), SãoPaulo) = True Then
    f("Day" & a + gOffset).ForeColor = vbRed
    Else
    f("Day" & a + gOffset).ForeColor = vbBlack
    End If

    'Adicionei para deixar em vermelho se domingo
    If Format(workdate - 1, "dddd") = "domingo" Then
    f("Day" & a + gOffset).ForeColor = vbRed
    Else
    End If

    Next
    Call PutInData

    End Function


    'Utilizar a função de Feriados do Grande alexandre http://maximoaccess.forumeiros.com/t971-feriados-brasileiros?highlight=feriados
    'Salve o código abaixo em um novo módulo
    Option Compare Database
    Option Explicit

    Enum NomeEstado
    Acre = 1
    Alagoas = 2
    Amapá = 3
    Amazonas = 4
    Bahía = 5
    Ceará = 6
    DistritoFederal = 7
    EspíritoSanto = 8
    Goiás = 9
    Maranhão = 10
    MatoGrosso = 11
    MatoGrossoDoSul = 12
    MinasGerais = 13
    Pará = 14
    Paraíba = 15
    Paraná = 16
    Pernambuco = 17
    Piauí = 18
    RioDeJaneiro = 19
    RioGrandeDoNorte = 20
    RioGrandeDoSul = 21
    Rondônia = 22
    Roraima = 23
    SantaCatarina = 24
    SãoPaulo = 25
    Sergipe = 26
    Tocantins = 27
    End Enum

    Public Function PascoaB(intAno As Integer) As Date
    Dim X As Byte, Y As Byte
    Dim a As Byte, B As Byte, c As Byte, d As Byte, e As Byte

    If intAno > 1581 And intAno < 1600 Then X = 22: Y = 2
    If intAno > 1599 And intAno < 1700 Then X = 22: Y = 2
    If intAno > 1699 And intAno < 1800 Then X = 23: Y = 3
    If intAno > 1799 And intAno < 1900 Then X = 23: Y = 4
    If intAno > 1899 And intAno < 2000 Then X = 24: Y = 5
    If intAno > 1999 And intAno < 2100 Then X = 24: Y = 5
    If intAno > 2099 And intAno < 2200 Then X = 24: Y = 6
    If intAno > 2199 And intAno < 2300 Then X = 25: Y = 7

    a = intAno Mod 19
    B = intAno Mod 4
    c = intAno Mod 7
    d = ((19 * a) + X) Mod 30
    e = ((2 * B) + (4 * c) + (6 * d) + Y) Mod 7
    If (d + e) < 10 Then
    PascoaB = DateSerial(intAno, 3, d + e + 22)
    Else
    PascoaB = DateSerial(intAno, 4, d + e - 9)
    End If
    If PascoaB = DateSerial(intAno, 4, 26) Then PascoaB = DateAdd("d", -7, PascoaB)
    If PascoaB = DateSerial(intAno, 4, 25) And d = 28 And a > 10 Then PascoaB = DateAdd("d", -7, PascoaB)
    End Function

    Public Function FeriadoBrasileiro(dtData As Date, Optional strNomeEstado As NomeEstado) As Boolean
    'criada por Alexandre Neves
    'www.esnips.com\web\AlexandreNeves
    FeriadoBrasileiro = False
    Select Case Format(dtData, "dd-mm")
    Case "01-01"
    FeriadoBrasileiro = True
    Case "21-04"
    FeriadoBrasileiro = True
    Case "01-05"
    FeriadoBrasileiro = True
    Case "07-09"
    FeriadoBrasileiro = True
    Case "12-10"
    FeriadoBrasileiro = True
    Case "02-11"
    FeriadoBrasileiro = True
    Case "15-11"
    FeriadoBrasileiro = True
    Case "25-12"
    FeriadoBrasileiro = True
    End Select

    If dtData = DateAdd("d", -47, PascoaB(year(dtData))) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", -2, PascoaB(year(dtData))) Then FeriadoBrasileiro = True
    If dtData = PascoaB(year(dtData)) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", 49, PascoaB(year(dtData))) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", 56, PascoaB(year(dtData))) Then FeriadoBrasileiro = True
    If dtData = DateAdd("d", 60, PascoaB(year(dtData))) Then FeriadoBrasileiro = True

    If Not IsMissing(strNomeEstado) Then
    Select Case strNomeEstado
    Case Acre
    If Format(dtData, "dd-mm") = "15-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "06-08" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "17-11" Then FeriadoBrasileiro = True
    Case Alagoas
    If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "16-09" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case Amapá
    If Format(dtData, "dd-mm") = "19-03" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case Amazonas
    If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
    Case Bahía
    If Format(dtData, "dd-mm") = "28-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "02-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case DistritoFederal
    If Format(dtData, "dd-mm") = "21-04" Then FeriadoBrasileiro = True
    Case EspíritoSanto
    If Format(dtData, "dd-mm") = "23-05" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
    Case Goiás
    If Format(dtData, "dd-mm") = "26-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
    Case Maranhão
    If Format(dtData, "dd-mm") = "28-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-12" Then FeriadoBrasileiro = True
    Case MatoGrosso
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case MatoGrossoDoSul
    If Format(dtData, "dd-mm") = "11-10" Then FeriadoBrasileiro = True
    Case Pará
    If Format(dtData, "dd-mm") = "15-08" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
    Case Paraíba
    If Format(dtData, "dd-mm") = "05-08" Then FeriadoBrasileiro = True
    Case Paraná
    If Format(dtData, "dd-mm") = "08-09" Then FeriadoBrasileiro = True
    Case Pernambuco
    If Format(dtData, "dd-mm") = "06-03" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
    Case Piauí
    If Format(dtData, "dd-mm") = "13-03" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "19-10" Then FeriadoBrasileiro = True
    Case RioDeJaneiro
    If Format(dtData, "dd-mm") = "21-01" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "23-04" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "18-10" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case RioGrandeDoNorte
    If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "03-10" Then FeriadoBrasileiro = True
    Case RioGrandeDoSul
    If Format(dtData, "dd-mm") = "20-09" Then FeriadoBrasileiro = True
    Case Rondônia
    If Format(dtData, "dd-mm") = "04-01" Then FeriadoBrasileiro = True
    Case Roraima
    If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
    Case SantaCatarina
    If Format(dtData, "dd-mm") = "11-08" Then FeriadoBrasileiro = True
    Case SãoPaulo
    If Format(dtData, "dd-mm") = "09-07" Then FeriadoBrasileiro = True
    If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
    Case Sergipe
    If Format(dtData, "dd-mm") = "08-07" Then FeriadoBrasileiro = True
    Case Tocantins
    If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
    End Select
    End If
    End Function


    Última edição por topbr em Dom 11 Dez - 23:45, editado 2 vez(es)
    avatar
    Convidad
    Convidado


    Calendario de Eventos (Adaptado com feriados brasileiros) Empty Re: Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Convidad Dom 11 Dez - 23:28

    Olá

    Testando aqui, apresentou o seguinte erro:


    > f("horario" & a + gOffset).Visible = False


    Última edição por norbs em Sáb 17 Dez - 7:05, editado 1 vez(es)
    Gilberto Rocha
    Gilberto Rocha
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1027
    Registrado : 21/01/2010

    Calendario de Eventos (Adaptado com feriados brasileiros) Empty Re: Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Gilberto Rocha Dom 11 Dez - 23:42

    Esse campo é de meu bd, pois adicionei tambem um campo horário.
    Retirei no código acima, tire de seu banco e teste.


    Última edição por topbr em Seg 12 Dez - 1:51, editado 1 vez(es)
    avatar
    Convidad
    Convidado


    Calendario de Eventos (Adaptado com feriados brasileiros) Empty Re: Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Convidad Dom 11 Dez - 23:57

    Perfeito!

    Ótima contribuição. Parabéns!

    Abraço!

    Conteúdo patrocinado


    Calendario de Eventos (Adaptado com feriados brasileiros) Empty Re: Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Conteúdo patrocinado


      Data/hora atual: Qui 28 Mar - 22:16