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
https://dl.dropbox.com/u/26441349/Feriados.rar
Cumprimentos.
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
https://dl.dropbox.com/u/26441349/Feriados.rar
Cumprimentos.