MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    Calendario de Eventos (Adaptado com feriados brasileiros)

    Compartilhe
    avatar
    Gilberto Rocha
    Developer
    Developer

    Respeito às Regras 100%

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

    Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Gilberto Rocha em Sab 10 Dez 2011, 02: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

    [Você precisa estar registrado e conectado para ver este link.]


    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 [Você precisa estar registrado e conectado para ver este link.]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
    '[Você precisa estar registrado e conectado para ver este link.]
    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 Seg 12 Dez 2011, 01:45, editado 2 vez(es)

    Convidad
    Convidado

    Re: Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Convidad em Seg 12 Dez 2011, 01:28

    Olá

    Testando aqui, apresentou o seguinte erro:


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


    Última edição por norbs em Sab 17 Dez 2011, 09:05, editado 1 vez(es)
    avatar
    Gilberto Rocha
    Developer
    Developer

    Respeito às Regras 100%

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

    Re: Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Gilberto Rocha em Seg 12 Dez 2011, 01: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 2011, 03:51, editado 1 vez(es)

    Convidad
    Convidado

    Re: Calendario de Eventos (Adaptado com feriados brasileiros)

    Mensagem  Convidad em Seg 12 Dez 2011, 01:57

    Perfeito!

    Ótima contribuição. Parabéns!

    Abraço!

      Data/hora atual: Qua 18 Out 2017, 15:39