Discussion :

[ghosty04]

bonjour,

Est-ce que quelqu'un sait comment savoir si une date est un jour férié ou samedi/dimanche dans VBA

merci

[drakkar_agfa]

Bonjour,

Quelques sujets parlent déja des jours fériés :
http://www.developpez.net/forums/d57...s-jour-feries/

La FAQ pour les jours ouvrables :
http://access.developpez.com/faq/?pa...nip#NbJourOuvr

Et ici pour le weekend :
http://www.developpez.net/forums/d54...date-week-end/

Tu devrais avoir quelques pistes avec ceci. Et sinon, propose ton code commencé!

[squall62]

Salut,

Je ne pense pas que Vb en soit capable puisque les jours fériés ne sont pas les mêmes pour tous les pays.
Par contre si ce n'est que pour une période définie tu peux très bien entrer les dates fériées dans un tableau et réaliser des tests.

[Ronambélé]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Function IsWeekend(InputDate As Date) As Boolean
    Select Case Weekday(InputDate)
        Case vbSaturday, vbSunday
            IsWeekend = True
        Case Else
            IsWeekend = False
    End Select
End Function

[Invité]

Bonjour,
le fête catholique sont toujours fixé en fonction de pâque;
Aïd, Yom Kipour je sais pas.
pour les fête nationale le 14 juillet, le 4 juillet et autre il faut te faire un tableau selon le pays!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub test()
Dim FerierNationeau()
FerierNationeau = Array(Array("05-08", "08-14"), Array("01-01", "08-04"))
Debug.Print "Fête Nationale Française : " & CDate(Format(Date, "yyyy-") & FerierNationeau(0)(1))
Debug.Print "Fête Nationale Amméricaine : " & CDate(Format(Date, "yyyy-") & FerierNationeau(1)(1))
End Sub

[kiki29]

Salut, et une de plus pour la route .....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
 
Dim JFeries(11) As Long
 
Private Sub JoursFeries(An As Long)
Dim Nb As Long, Epacte As Long
Dim PLune As Date, LPaques As Date
Dim i As Long, j As Long, k As Long, tmp As Long
 
    '   Calcul du Lundi de Pâques
    Nb = (An Mod 19) + 1
    '   Différence entre calendrier solaire et lunaire
    Epacte = (11 * Nb - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
    PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
    If Epacte = 24 Then PLune = PLune - 1
    '   Valable entre 1900 et 2199 : on verra bien ?
    If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
    '   Lundi de Pâques
    LPaques = PLune - Weekday(PLune) + vbMonday + 7
 
    Erase JFeries
 
    '   Jour de l'An
    JFeries(1) = DateSerial(An, 1, 1)
    '   Paques
    JFeries(2) = LPaques
    '   Ascension
    JFeries(3) = LPaques + 38
    '   Pentecôte
    JFeries(4) = LPaques + 49
    '   Fete du travail
    JFeries(5) = DateSerial(An, 5, 1)
    '   Anniversire 1945
    JFeries(6) = DateSerial(An, 5, 8)
    '   Fete Nationale
    JFeries(7) = DateSerial(An, 7, 14)
    '   Assomption
    JFeries(8) = DateSerial(An, 8, 15)
    '   Toussaint
    JFeries(9) = DateSerial(An, 11, 1)
    '   Armistice 1918
    JFeries(10) = DateSerial(An, 11, 11)
    '   Noel
    JFeries(11) = DateSerial(An, 12, 25)
 
    '   Tri Tableau JFeries()
    For i = LBound(JFeries) To UBound(JFeries)
        j = i
        For k = j + 1 To UBound(JFeries)
            If JFeries(k) <= JFeries(j) Then j = k
        Next k
        If i <> j Then
            tmp = JFeries(j)
            JFeries(j) = JFeries(i)
            JFeries(i) = tmp
        End If
    Next i
End Sub

[Invité]

Regarde le fichier joint!

[Helloweed]

Salut, et une de plus pour la route .....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
 
Dim JFeries(11) As Long
 
Private Sub JoursFeries(An As Long)
Dim Nb As Long, Epacte As Long
Dim PLune As Date, LPaques As Date
Dim i As Long, j As Long, k As Long, tmp As Long
 
    '   Calcul du Lundi de Pâques
    Nb = (An Mod 19) + 1
    '   Différence entre calendrier solaire et lunaire
    Epacte = (11 * Nb - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
    PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
    If Epacte = 24 Then PLune = PLune - 1
    '   Valable entre 1900 et 2199 : on verra bien ?
    If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
    '   Lundi de Pâques
    LPaques = PLune - Weekday(PLune) + vbMonday + 7
 
    Erase JFeries
 
    '   Jour de l'An
    JFeries(1) = DateSerial(An, 1, 1)
    '   Paques
    JFeries(2) = LPaques
    '   Ascension
    JFeries(3) = LPaques + 38
    '   Pentecôte
    JFeries(4) = LPaques + 49
    '   Fete du travail
    JFeries(5) = DateSerial(An, 5, 1)
    '   Anniversire 1945
    JFeries(6) = DateSerial(An, 5, 8)
    '   Fete Nationale
    JFeries(7) = DateSerial(An, 7, 14)
    '   Assomption
    JFeries(8) = DateSerial(An, 8, 15)
    '   Toussaint
    JFeries(9) = DateSerial(An, 11, 1)
    '   Armistice 1918
    JFeries(10) = DateSerial(An, 11, 11)
    '   Noel
    JFeries(11) = DateSerial(An, 12, 25)
 
    '   Tri Tableau JFeries()
    For i = LBound(JFeries) To UBound(JFeries)
        j = i
        For k = j + 1 To UBound(JFeries)
            If JFeries(k) <= JFeries(j) Then j = k
        Next k
        If i <> j Then
            tmp = JFeries(j)
            JFeries(j) = JFeries(i)
            JFeries(i) = tmp
        End If
    Next i
End Sub

Comment exécute-t-on le code ? Je ne comprends pas vraiment ce qui bloque.

[kiki29]

Salut, cette procédure permet de remplir un tableau JFeries pour l'année x.
Ne tient pas compte des jours fériés supplémentaires en Alsace Moselle, Guadeloupe, Guyane, Martinique, Mayotte, Nouvelle Calédonie, Polynésie, Réunion, Wallis Futuna contrairement à Calendrier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub Tst()
Dim i As Long
    JoursFeries 2018
    For i = 1 To 11
        Feuil1.Cells(i, 1) = JFeries(i)
    Next i
End Sub

[Qwazerty]

Salut

J'avais posté ça il y a quelques années . Pas de code VBA, que des formules. Par contre il n'y a que les jours fériés français.

++
Qwaz

[Helloweed]

Salut, cette procédure permet de remplir un tableau JFeries pour l'année x.
Ne tient pas compte des jours fériés supplémentaires en Alsace Moselle, Guadeloupe, Guyane, Martinique, Mayotte, Nouvelle Calédonie, Polynésie, Réunion, Wallis Futuna contrairement à Calendrier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub Tst()
Dim i As Long
    JoursFeries 2018
    For i = 1 To 11
        Feuil1.Cells(i, 1) = JFeries(i)
    Next i
End Sub

Je découvre peu à peu le langage informatique. Je trouve ça génial.

Je ne comprenais pas pourquoi ne n'arrivais pas à lancer la procédure ""Private Sub JoursFeries(An As Long)"". Mais c'est seulement parce qu'il faut assigner une valeur à la variable "An" déclarée dans la parenthèse. J'essayais de définir cette dernière dans la procédure elle même mais ça ne fonctionnait pas. J'en apprends chaque jour un peu plus. Mais j'ai de grosses lacunes encore sur les classes. Pas vraiment intuitif. Merci en tout cas.

[Qwazerty]

Salut

Pour tester ce genre de function qui attendent un ou plusieurs paramètres, tu peux créer une petite procédure (Sub),

Exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub TestFunc()
Dim yFeries As Byte
'On execute la fonction pour connaitre les Jours Feries de 2018
'Cette fonction renseigne le tableau JFeries
JoursFeries 2018
 
'On affiche le contenu du tableau JFeries dans la feuil1
With Feuil1.Range("A1")
    .Value = "Les jours fériés"
    For yFeries = 1 To 11
        Feuil1.Range("A1").Offset(yFeries).Value = JFeries(yFeries)
    Next
 
    'On change le format de cellule pour afficher les dates
    .Offset(1).Resize(11, 1).NumberFormat = "m/d/yyyy"
 
    'On ajuste la largeur de la colonne
    .EntireColumn.AutoFit
 
End With
 
End Sub

++
Qwaz