DIA E FERIADO

ALANTB 31/08/2012 13:14:48
#409015
Gente, tenho um botão em um form em VBA Excel 2003 que carrega um listview com os dias do mês informando uma data inicial.Também exibe os dias da semana.é um controle de entradas e saidas e valor a pagar por dia.Só que preciso que nos dias que for feriado, seja exibido a palavra FERIADO na linha correspondente do mês. Com sabados e domingos já consegui. Só que quando se trata de feriados envolve funções, e não sei como chamar essas funções. A parte inicial consegui com a ajuda dos colegas do forum e pesquisando aqui mesmo no forum achei uma função, mas não estou conseguindo juntar as duas coisas. Segue:

O que eu tenho no momento funcionando:
Private Sub cmdGerar_Click()
Dim bFeriado As Boolean

l = txtTotalDiasTrabalhados.Text [ô] Quantidade de DIAS
Dim MyArray(31) As Date [ô] Indica que o numero Maximo de DIAS será 31
Dim i As Integer
MyArray(0) = txtDataInicial.Text [ô] Indica que Myarray começara no (0) que será o valor de txtdatainicial
For i = 0 To l [ô] Indica que (i) irá de 0 até o Valor de (l)
MyArray(i) = DateAdd([Ô]d[Ô], i, txtDataInicial) [ô] indica que Myarray Somara o Valor de (i) que será o Numero de dias e (d) indica o dia
Dim lst As ListItem
Set lst = ListView1.ListItems.Add(, , Text)
lst.ListSubItems.Add Text:=Format(MyArray(i), [Ô]dd/mm/yyyy[Ô]) [ô] Indica que O Numero de dias Será Inserido em lst
lst.ListSubItems.Add Text:=WeekdayName(Weekday((MyArray(i)))) [ô] ja vai retornar o dia da semana (segunda, terça....)

If Weekday(MyArray(i)) = 1 Then [ô]Or Weekday(MyArray(i)) = 7 Then [ô] Se for de segunda a sexta acrescenta o restante

lst.ListSubItems.Add Text:=[Ô]Domingo[Ô]
lst.ListSubItems.Add Text:=[Ô]Domingo[Ô]
lst.ListSubItems.Add Text:=[Ô]Domingo[Ô]
lst.ListSubItems.Add Text:=[Ô]Domingo[Ô]
lst.ListSubItems.Add Text:=[Ô]0[Ô]
lst.ListSubItems.Add Text:=[Ô]0[Ô]
lst.ListSubItems.Add Text:=[Ô]0[Ô]

ElseIf Weekday(MyArray(i)) = 7 Then
lst.ListSubItems.Add Text:=[Ô]Sábado[Ô]
lst.ListSubItems.Add Text:=[Ô]Sábado[Ô]
lst.ListSubItems.Add Text:=[Ô]Sábado[Ô]
lst.ListSubItems.Add Text:=[Ô]Sábado[Ô]
lst.ListSubItems.Add Text:=[Ô]0[Ô]
lst.ListSubItems.Add Text:=[Ô]0[Ô]
lst.ListSubItems.Add Text:=[Ô]0[Ô]

[ô] ElseIf bFeriado = EFeriado(Weekday(MyArray(i))) Then [ô] nesse trecho comentado do código que preciso inserir a função feriado
[ô] bFeriado = True
[ô] lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtEntrada.Text
[ô] lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtSaida.Text
[ô] lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtEntrada2.Text
[ô] lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtSaida2.Text
[ô] lst.ListSubItems.Add Text:=[Ô]0[Ô] [ô]Format(Me.ComboBox_CargaHorariaDia, [Ô]h:mm[Ô])
[ô] lst.ListSubItems.Add Text:=[Ô]0[Ô] [ô]ComboBox_ValorHora.Text
[ô] lst.ListSubItems.Add Text:=[Ô]0[Ô] [ô]txtValorReceber.Text

Else

lst.ListSubItems.Add Text:=Me.txtEntrada.Text
lst.ListSubItems.Add Text:=Me.txtSaida.Text
lst.ListSubItems.Add Text:=Me.txtEntrada2.Text
lst.ListSubItems.Add Text:=Me.txtSaida2.Text
lst.ListSubItems.Add Text:=Format(Me.ComboBox_CargaHorariaDia, [Ô]h:mm[Ô])
lst.ListSubItems.Add Text:=ComboBox_ValorHora.Text
lst.ListSubItems.Add Text:=txtValorReceber.Text

End If

Next [ô] Indica que tera que voltar no começo até que Myarray seja do mesmo valor de (l)

ExportaParaPlanilha

End Sub

ESSA é A FUNÇÃO QUE DESCOBRI AQUI NO FORUM:
Private Function VerificaSeFeriado(dDataX As Date) As Boolean

Dim FeriadosFixos(7) As Date
Dim FeriadosMoveis(2) As Date
Dim iAnoX As Integer
Dim dPascoa As Date

iAnoX = Year(dDataX)
dPascoa = CalculaPascoa(iAnoX)

FeriadosFixos(0) = CDate([Ô]1/1/[Ô] & iAnoX) [ô]Confraternização Universal
FeriadosFixos(1) = CDate([Ô]21/4/[Ô] & iAnoX) [ô]Tiradentes
FeriadosFixos(2) = CDate([Ô]1/5/[Ô] & iAnoX) [ô]Trabalho
FeriadosFixos(3) = CDate([Ô]7/9/[Ô] & iAnoX) [ô]Independência do Brasil
FeriadosFixos(4) = CDate([Ô]12/10/[Ô] & iAnoX) [ô]Nossa Senhora Aparecida
FeriadosFixos(5) = CDate([Ô]2/11/[Ô] & iAnoX) [ô]Finados
FeriadosFixos(6) = CDate([Ô]15/11/[Ô] & iAnoX) [ô]Proclamação da Repúplica
FeriadosFixos(7) = CDate([Ô]25/12/[Ô] & iAnoX) [ô]Natal

FeriadosMoveis(0) = DateAdd([Ô]d[Ô], -2, dPascoa) [ô]Sexta Paixão
FeriadosMoveis(1) = DateAdd([Ô]d[Ô], -47, dPascoa) [ô]Carnaval
FeriadosMoveis(2) = DateAdd([Ô]d[Ô], 60, dPascoa) [ô]Corpus Christi


Select Case dDataX
Case FeriadosFixos(0), FeriadosFixos(1), FeriadosFixos(2), FeriadosFixos(3), FeriadosFixos(4), FeriadosFixos(5), FeriadosFixos(6), FeriadosFixos(7)
VerificaSeFeriado = True
Case FeriadosMoveis(0), FeriadosMoveis(1), FeriadosMoveis(2)
VerificaSeFeriado = True
Case Else
VerificaSeFeriado = False
End Select


End Function
Private Function CalculaPascoa(iAno As Integer) As Date
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim G As Integer
Dim H As Integer
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim L As Integer
Dim M As Integer
Dim N As Integer
Dim P As Integer
Dim Q As Integer
Dim R As Integer
Dim S As Integer

A = iAno \ 100 [ô]o inteiro de (Ano ÷ 100)
B = iAno Mod 19 [ô]o resto de (Ano ÷ 19)
C = (A - 17) \ 25 [ô]o inteiro de [(A - 17) ÷ 25]
D = A \ 4 [ô]o inteiro de (A ÷ 4)
E = (A - C) \ 3 [ô]o inteiro de [(A - C) ÷ 3]
F = (A - D - E + (19 * B) + 15) Mod 30 [ô]o resto de {[A - D - E + (19xB) + 15] ÷ 30}
G = F \ 28 [ô]o inteiro de (F ÷ 28)
H = 29 \ (F + 1) [ô]o inteiro de [29 ÷ (F + 1)]
I = (21 - B) \ 11 [ô]o inteiro de [(21 - B) ÷ 11]
J = G * H * I
K = F - (G * (1 - J))
L = iAno \ 4 [ô]o inteiro de (Ano ÷ 4)
M = (iAno + L + K + 2 - A + D) Mod 7 [ô]o resto de [(Ano + L + K + 2 - A + D) ÷ 7]
N = K - M
P = (N + 40) \ 44 [ô]o inteiro de [(N + 40) ÷ 44]
Q = 3 + P
R = Q \ 4 [ô]o inteiro de (Q ÷ 4)
S = N + 28 - (31 * R)

CalculaPascoa = CDate(S & [Ô]/[Ô] & Q & [Ô]/[Ô] & iAno)

End Function
MARCELO.TREZE 31/08/2012 13:55:22
#409017 Resposta escolhida
acho que vc não coloca o weekday() nesta função, pois não vai retornar uma data que é o que a Função pede então tente isso

ElseIf EFeriado(MyArray(i)) = True Then
          lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtEntrada.Text
          lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtSaida.Text
          lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtEntrada2.Text
          lst.ListSubItems.Add Text:=[Ô]Feriado[Ô] [ô]Me.txtSaida2.Text
          lst.ListSubItems.Add Text:=[Ô]0[Ô] [ô]Format(Me.ComboBox_CargaHorariaDia, [Ô]h:mm[Ô])
          lst.ListSubItems.Add Text:=[Ô]0[Ô] [ô]ComboBox_ValorHora.Text
          lst.ListSubItems.Add Text:=[Ô]0[Ô] [ô]txtValorReceber.Text


acho que já resolve
ALANTB 31/08/2012 14:36:47
#409022
MARCELO-TREZE fechou todas. Vou encerrar e pontuar.....!!!!!!!!!!!
Tópico encerrado , respostas não são mais permitidas
Voltar