|
Postada em 26/01/2006 12:33 hs
Boa Tarde Pessoal Alguem tem uma funçao que verifique se um certo dia de uma data é dia util se nao for passa para a proxima dia
Anderson Barreto
|
|
|
|
|
Postada em 26/01/2006 12:37 hs
if diasemana = 1 or diasemana = 7 then msgbox "dia nao util" else msgbox "dia util" endif
|
|
|
|
Postada em 26/01/2006 12:59 hs
não é isso a função que estou usando e a seguinte ela funciona mais antes de sair da função ela faz um loop e retorna com o valor original Function spf_calcula_dia_util(Str_Data As String) Dim A, B, c, D, E, F, G, H, i, k, L, m, P, Q As Long, Ano, dt_Pascoa, dt_Carnaval, dt_SextaSanta, dt_CorpusC As Date 'Função que calcula Feriados móveis Ano = Year(CDate(Str_Data)) A = (Ano Mod 19) B = Int(Ano / 100) c = (Ano Mod 100) D = Int(B / 4) E = (B Mod 4) F = Int((B + 8) / 25) G = Int((B - F + 1) / 3) H = ((19 * A + B - D - G + 15) Mod 30) i = Int(c / 4) k = (c Mod 4) L = ((32 + 2 * E + 2 * i - H - k) Mod 7) m = Int((A + 11 * H + 22 * L) / 451) P = Int((H + L - 7 * m + 114) / 31) Q = ((H + L - 7 * m + 114) Mod 31) dt_Pascoa = CDate((Q + 1) & "/" & P & "/" & Ano) dt_Carnaval = DateAdd("d", -47, dt_Pascoa) dt_SextaSanta = DateAdd("d", -2, dt_Pascoa) dt_CorpusC = DateAdd("d", 60, dt_Pascoa) If Weekday(CDate(Str_Data)) = 1 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Domingo If Weekday(CDate(Str_Data)) = 7 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Sábado If CDate(Str_Data) = dt_Pascoa Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Pascoa If CDate(Str_Data) = dt_Carnaval Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Carnaval 'Carnaval If CDate(Str_Data) = dt_SextaSanta Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Sexta Santa If CDate(Str_Data) = dt_CorpusC Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Corpus Cristh If Month(CDate(Str_Data)) = 1 And Day(CDate(Str_Data)) = 1 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Confratenização Universal If CDate(Str_Data) = dt_Carnaval + 1 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'quarta feira de cinzas If Month(CDate(Str_Data)) = 4 And Day(CDate(Str_Data)) = 21 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'tiradentes''' If Month(CDate(Str_Data)) = 5 And Day(CDate(Str_Data)) = 1 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'dia do trabalho' If Month(CDate(Str_Data)) = 9 And Day(CDate(Str_Data)) = 7 Then: spf_calcula_dia_util (CDate(Str_Data) + 1) 'independencia If Month(CDate(Str_Data)) = 10 And Day(CDate(Str_Data)) = 12 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'N. S. Aparecida If Month(CDate(Str_Data)) = 11 And Day(CDate(Str_Data)) = 2 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Finados If Month(CDate(Str_Data)) = 11 And Day(CDate(Str_Data)) = 15 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Proclamação Republica If Month(CDate(Str_Data)) = 12 And Day(CDate(Str_Data)) = 25 Then: Str_Data = spf_calcula_dia_util(CDate(Str_Data) + 1) 'Natal MsgBox Str_Data End Function
Anderson Barreto
|
|
|
Keyo
|
CURITIBA PR - BRASIL
|
|
ENUNCIADA !
|
|
|
Postada em 26/01/2006 13:04 hs
'Veja se este código clareia as suas idéias,,,é simples mas funga Private Sub Command1_Click() Dim resp As String For i = 1 To 7 resp = Format(Date, "dddd") MsgBox resp, vbInformation, "Data" If resp <> "domingo" And resp <> "sábado" Then MsgBox "Dia útil", vbInformation, "Data" Else MsgBox "Dia não útil", vbInformation, "Data" End If Date = Date + 1 Next i End Sub
|
|
|
Tekki
|
UBERLÂNDIA MG - BRASIL
|
|
ENUNCIADA !
|
|
|
Postada em 26/01/2006 19:27 hs
Anderson, só um comentário. Suas variáveis A, B, c, D, E, F, G, H, i, k, L, m, P são do tipo Variant e as Ano, dt_Pascoa, dt_Carnaval, dt_SextaSanta também são Variant A variável Q é do tipo long e a dt_CorpusC é do tipo data. Faça o teste. Private Sub Command1_Click() Dim A, B, C, D, E, F, G, H, i, k, L, m, P, Q As Long, Ano, dt_Pascoa, dt_Carnaval, dt_SextaSanta, dt_CorpusC As Date A = "Teste" 'String B = CDate("01/01/2001") 'Data Set C = Me 'Form C.Caption = "Teste" dt_Carnaval = "012345679-abcdef..." 'Nesta vai dar erro Q = "Teste" End Sub 'Dim A As Long, B As Long, ..., Q As Long, Ano As Date, ... , dt_CorpusC As Date O VB tem esta particularidade na declaração de variáveis. Sei que este não é o seu problema mas é só um dica.
|
|
|
|
Postada em 27/01/2006 08:01 hs
Valeu Tekki , tudo que é certo ajuda
Anderson Barreto
|
|
|
|