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

    Feriados Nacionais no Ano (Inserção automática em tabela, com data, dia da Semana e Nome do Feriado)

    Compartilhe
    avatar
    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12266
    Registrado : 01/03/2011

    Feriados Nacionais no Ano (Inserção automática em tabela, com data, dia da Semana e Nome do Feriado)

    Mensagem  HARYSOHN em Seg 03 Set 2012, 16:56

    Utilizando a função do Mestre Alexandre Neves, adaptado com o nome dos feriados, este exemplo insere automaticamente na tabela ao abrir o form, caso a ultima informação Ano na tabela seja diferente do ano atual.

    Código utilizado:

    Sub CriaFeriados()
    'Declaração de variáveis
    Dim DataIni, DataFin, MesVar, StrAno, DataRef As Date
    Dim DifDias, X, Y, UltimoDia As Integer
    Dim DiaSemana As String

    'Carrega uma informação de Data da tabela
    StrAno = Format(DLookup("DataFeriado", "tblFeriados"), "yyyy")

    'Checo o ano da última informação gravada na tabela comparando com o ano atual
    If StrAno <> Format(Date, "yyyy") Then
    CurrentDb.Execute "Delete * From tblFeriados"

    'Define o primeiro dia do Ano
    DataIni = DateSerial(Year(Date), 1, 1)
    'Define o último dia do Ano
    DataFin = DateSerial(Year(Date), 12 + 1, 0)
    'Define a quantidade de dias do Ano
    DifDias = DataFin - DataIni
    'Adiciono a variável MesVar a data inicial do ano (Primeiro dia)
    MesVar = DataIni
    'Extraio o último dia do mês inicial, para utilização no procedimento que executa o loop nos dias do mês
    UltimoDia = Format(DateSerial(Year(Date), Month(MesVar) + 1, 0), "dd")

    'Faz um loop por doze vezes indicando os 12 meses do ano
    For X = 1 To 12
    'Executando a sequencia de 12 loop's dentro destes os loop's pelo mes (dias)
    'Observe que utilizo como paramento inicial o dia 1 e para o final o Ultimo dia do Mês

    For Y = 1 To UltimoDia
    'Esta variável carrega a data a cada loop no formato, observe que transformo a informação no Tipo data utilizando o CDate
    DataRef = CDate(Y & "/" & Format(MesVar, "mm") & "/" & Year(Date))
    If FeriadoBrasileiro(DataRef) = True Then
    'Coloca na variável o dia da Semana
    DiaSemana = WeekdayName(Weekday(DataRef))
    'Executa a inserção dos valores na tabela tblFerliados
    CurrentDb.Execute "INSERT INTO tblFeriados(DataFeriado, Semana, Descrição)" _
    & " Values(""" & Format(DataRef, "dd/mm/yyyy") & """,""" & DiaSemana & """," _
    & """" & NomeFeriado & """);"
    'Limpa a variável pública que contem o nome do feriado
    NomeFeriado = ""
    End If
    'Vai para o Próximo dia
    Next Y
    'Aqui Adiciono um mês a Data contida na variável MesVar, para na linha seguinte extrair o último dia do mês
    MesVar = DateAdd("m", 1, MesVar)
    'Extraio o último dia do proximo mês para a utilização no Procedimento For Y = 1 To UltimoDia
    UltimoDia = Format(DateSerial(Year(Date), Month(MesVar) + 1, 0), "dd")
    'Vai para o Próximo Mês
    Next X
    Me.Requery
    MsgBox "Feriados inseridos com sucesso!", vbInformation, "Atualizado"
    Else
    Exit Sub
    End If
    End Sub


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

    Cumprimentos.


    .................................................................................
    PILOTO
    الله أكبر Paz, Justiça e Liberdade! الله أكبر
    [Você precisa estar registrado e conectado para ver este link.]

    Iniciando no Access? Então veja esse [Você precisa estar registrado e conectado para ver este link.] e também [Você precisa estar registrado e conectado para ver este link.]


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

    Quando tua dúvida for RESOLVIDA, dê retorno com AGRADECIMENTO a aqueles que gastaram seu tempo em te ajudar.
    Clique no botão Resolvido logo acima do botão Enviar, do lado direito. Todos nós agradecemos.  
    [Você precisa estar registrado e conectado para ver esta imagem.]

      Data/hora atual: Qui 14 Dez 2017, 13:07