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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
| ' Cette fonction renvoie Vrai si la date transmise est un jour férié
' fixe ou mobile
' les lundis de pâques sont calculés
Public Function RetourneDate(M As String, Annee As String) As Date
Dim moi
moi = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
For I = 1 To 12
If UCase("" & moi(I)) = UCase("" & M) Then Exit For
Next
RetourneDate = "01/" & Format(I, "00") & "/" & Annee
End Function
Function Ferie(UneDate As Long) As Boolean
' Par défaut la fonction ne considère pas que les Dimanche de Pâques
' et de Pentecôte sont fériés
' il suffit de renseigner l'argument DimanchesOuiNon à True à l'appel de la fonction
' pour les considérer comme fériés
Ferie = IsDimange(UneDate)
If Ferie = True Then Exit Function
Dim JFF ' table des fériés fixes (jours)
Dim MFF ' table des fériés fixes (mois)
JFF = Array(1, 1, 8, 14, 15, 1, 11, 25)
MFF = Array(1, 5, 5, 7, 8, 11, 11, 12)
Dim J As Long
Ferie = False
' Recherche dans la table des jours fériés fixes
For J = 0 To 7
If Day(UneDate) = JFF(J) And Month(UneDate) = MFF(J) Then
Ferie = True
Exit Function
End If
Next J
Dim FM ' contient les dates des lundis de Paques
'FM = Array(38824, 39181, 39531, 39916, 40273, 40658, 41008, _
'41365, 41750, 42100, 42457, 42842, _
'43192, 43577, 43934, 44291, 44675, _
'45026, 45383, 45768, 46118, 46475, _
'46860, 47210, 47595)
FM = Paque(Year(UneDate))
' Recherche si la date est un lundi de paques
' ou jeudi de l'ascension
' ou lundi de pentecôte
'For J = 0 To 24 ' à changer si vous allez au delà de 2030
If (UneDate = FM) Or (UneDate = FM + 39) Or (UneDate = FM + 50) Then
Ferie = True
Exit Function
End If
' si DimanchesOuiNon est vrai
' on teste les dimanches de Pâques et Pentecote
If DimanchesOuiNon Then
If (UneDate = FM - 1) Or (UneDate = FM + 48) Then
Ferie = True
Exit Function
End If
End If
'Next J
End Function
Function IsDimange(J) As Boolean
If Weekday(J) = 1 Or Weekday(J) = 7 Then IsDimange = True
End Function
Function MDDIF(A, B) As Long
MDDIF = DateDiff("d", A, B)
End Function
Function MuMod(V, D)
MuMod = Int(V / D)
End Function
Function Paque(Annee As Integer) As Date
Dim A, B, C, D, E, F, G, H, I, J, K, L, M, N, O
C = Annee - 1900
D = C Mod 19
E = (D * 7) + 1
F = Int(E / 19)
G = 11 * D - F + 4
H = G Mod 29
I = Int(C / 4)
J = C - H + I + 31
L = J Mod 7
K = J Mod 7
L = 25 - H - K
M = CDate("31/03/" & Annee)
Paque = M + L
End Function
Sub E()
Debug.Print Paque(2014)
End Sub
Public Function TemPTravaiL(B, Mois As String, T As String)
Dim moi
moi = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
For I = 1 To 12
If UCase("" & moi(I)) = UCase("" & Mois) Then Exit For
Next
TemPTravaiL = [TMP]
If UCase("" & moi(Month(B))) <> UCase("" & moi(I)) Then
TemPTravaiL = "00:00"
Exit Function
End If
If Weekday(B) = 1 Or Weekday(B) = 7 Then
TemPTravaiL = "00:00"
Exit Function
End If
If Ferie(CLng(B), True) = True Then TemPTravaiL = vbNull: Exit Function
TemPTravaiL = T
'SI(NB.JOURS.OUVRES(B8;B8)=0;"";TMP))
End Function |
Problème résultat fonction personnalisée
Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.
Répondre avec citation
: ça peut servir aux autres 
.
Partager