Suppresion du lundi de pentecote (sans polemique!)
3 réponses
Le Surcitaire
Bonjour à tous,
J'essai de modifier la macro de FS mais sans succes, quelqu'un aurait
une idee,
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer =
0)
'Frédéric Sigonneau
'Le dimanche de Pâques est calculé à l'aide de l'algorythme
'utilisé par la fonction FirstDayOfEaster, ce qui rend cette fonction
"autonome"
'mais limite sa validité (2099)
Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As
Integer
If annee > 2099 Or annee < 1900 Then
LesFetesMobiles = CVErr(xlErrValue)
Exit Function
End If
'Modification LeSurcitaire
'Pour suppression du Lundi de pentecote
If annee >= 2005 Then
LPent = 0
Exit Function
End If
'algorythme de la fonction FirstDayOfEaster (site Cheap Pearson)
'pour le calcul du dimanche de Pâques
D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21
DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _
((annee + annee \ 4 + D + (D > 48) + 1) Mod 7)
LPaq = DP + 1
JAsc = DP + 39
LPent = DP + 50
Select Case Fete
Case 1: LesFetesMobiles = JAsc
Case 2: LesFetesMobiles = LPent
Case Else: LesFetesMobiles = LPaq
End Select
End Function
--
enlever lesurcitaire
La Vie n'est rien sans la joie de vivre
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
AV
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0) Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As Integer If annee > 2099 Or annee < 1900 Then LesFetesMobiles = CVErr(xlErrValue) Exit Function End If D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21 DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _ ((annee + annee 4 + D + (D > 48) + 1) Mod 7) LPaq = DP + 1 JAsc = DP + 39 Select Case Fete Case 1: LesFetesMobiles = JAsc Case Else: LesFetesMobiles = LPaq End Select
AV
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0)
Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As Integer
If annee > 2099 Or annee < 1900 Then
LesFetesMobiles = CVErr(xlErrValue)
Exit Function
End If
D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21
DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _
((annee + annee 4 + D + (D > 48) + 1) Mod 7)
LPaq = DP + 1
JAsc = DP + 39
Select Case Fete
Case 1: LesFetesMobiles = JAsc
Case Else: LesFetesMobiles = LPaq
End Select
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0) Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As Integer If annee > 2099 Or annee < 1900 Then LesFetesMobiles = CVErr(xlErrValue) Exit Function End If D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21 DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _ ((annee + annee 4 + D + (D > 48) + 1) Mod 7) LPaq = DP + 1 JAsc = DP + 39 Select Case Fete Case 1: LesFetesMobiles = JAsc Case Else: LesFetesMobiles = LPaq End Select
AV
Le Surcitaire
AV a formulé la demande :
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0) Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As Integer If annee > 2099 Or annee < 1900 Then LesFetesMobiles = CVErr(xlErrValue) Exit Function End If D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21 DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _ ((annee + annee 4 + D + (D > 48) + 1) Mod 7) LPaq = DP + 1 JAsc = DP + 39 Select Case Fete Case 1: LesFetesMobiles = JAsc Case Else: LesFetesMobiles = LPaq End Select
AV
Merci c'est tellement evident :-[
-- enlever lesurcitaire La Vie n'est rien sans la joie de vivre
AV a formulé la demande :
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0)
Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As
Integer If annee > 2099 Or annee < 1900 Then
LesFetesMobiles = CVErr(xlErrValue)
Exit Function
End If
D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21
DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _
((annee + annee 4 + D + (D > 48) + 1) Mod 7)
LPaq = DP + 1
JAsc = DP + 39
Select Case Fete
Case 1: LesFetesMobiles = JAsc
Case Else: LesFetesMobiles = LPaq
End Select
AV
Merci c'est tellement evident :-[
--
enlever lesurcitaire
La Vie n'est rien sans la joie de vivre
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0) Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As Integer If annee > 2099 Or annee < 1900 Then LesFetesMobiles = CVErr(xlErrValue) Exit Function End If D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21 DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _ ((annee + annee 4 + D + (D > 48) + 1) Mod 7) LPaq = DP + 1 JAsc = DP + 39 Select Case Fete Case 1: LesFetesMobiles = JAsc Case Else: LesFetesMobiles = LPaq End Select
AV
Merci c'est tellement evident :-[
-- enlever lesurcitaire La Vie n'est rien sans la joie de vivre
LeSteph
Bonsoir, et sans polémique je me réjouis que tu aies trouvé ce code de F.S. car depuis que je te l'avais indiqué le 21/09 je pensais que tu n'avais pas lu le message alors que tu avais semé la bonne humeur sur le fil c'était un peu dommage... lSteph
"Le Surcitaire" a écrit dans le message de news:
Bonjour à tous,
J'essai de modifier la macro de FS mais sans succes, quelqu'un aurait une idee,
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0) 'Frédéric Sigonneau 'Le dimanche de Pâques est calculé à l'aide de l'algorythme 'utilisé par la fonction FirstDayOfEaster, ce qui rend cette fonction "autonome" 'mais limite sa validité (2099) Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As Integer
If annee > 2099 Or annee < 1900 Then LesFetesMobiles = CVErr(xlErrValue) Exit Function End If 'Modification LeSurcitaire 'Pour suppression du Lundi de pentecote If annee >= 2005 Then LPent = 0 Exit Function End If
'algorythme de la fonction FirstDayOfEaster (site Cheap Pearson) 'pour le calcul du dimanche de Pâques D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21 DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _ ((annee + annee 4 + D + (D > 48) + 1) Mod 7)
LPaq = DP + 1 JAsc = DP + 39 LPent = DP + 50
Select Case Fete Case 1: LesFetesMobiles = JAsc Case 2: LesFetesMobiles = LPent Case Else: LesFetesMobiles = LPaq End Select End Function
-- enlever lesurcitaire La Vie n'est rien sans la joie de vivre
Bonsoir,
et sans polémique
je me réjouis que tu aies trouvé ce code de F.S.
car depuis que je te l'avais indiqué le 21/09 je pensais que tu n'avais
pas lu le message alors que tu avais semé la bonne humeur sur le fil
c'était un peu dommage...
lSteph
"Le Surcitaire" <jdg74-lesurcitaire@tiscali.fr> a écrit dans le message de
news: mn.137f7d4adc2b4911.13377@tiscali.fr...
Bonjour à tous,
J'essai de modifier la macro de FS mais sans succes, quelqu'un aurait une
idee,
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0)
'Frédéric Sigonneau
'Le dimanche de Pâques est calculé à l'aide de l'algorythme
'utilisé par la fonction FirstDayOfEaster, ce qui rend cette fonction
"autonome"
'mais limite sa validité (2099)
Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As
Integer
If annee > 2099 Or annee < 1900 Then
LesFetesMobiles = CVErr(xlErrValue)
Exit Function
End If
'Modification LeSurcitaire
'Pour suppression du Lundi de pentecote
If annee >= 2005 Then
LPent = 0
Exit Function
End If
'algorythme de la fonction FirstDayOfEaster (site Cheap Pearson)
'pour le calcul du dimanche de Pâques
D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21
DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _
((annee + annee 4 + D + (D > 48) + 1) Mod 7)
LPaq = DP + 1
JAsc = DP + 39
LPent = DP + 50
Select Case Fete
Case 1: LesFetesMobiles = JAsc
Case 2: LesFetesMobiles = LPent
Case Else: LesFetesMobiles = LPaq
End Select
End Function
--
enlever lesurcitaire
La Vie n'est rien sans la joie de vivre
Bonsoir, et sans polémique je me réjouis que tu aies trouvé ce code de F.S. car depuis que je te l'avais indiqué le 21/09 je pensais que tu n'avais pas lu le message alors que tu avais semé la bonne humeur sur le fil c'était un peu dommage... lSteph
"Le Surcitaire" a écrit dans le message de news:
Bonjour à tous,
J'essai de modifier la macro de FS mais sans succes, quelqu'un aurait une idee,
Function LesFetesMobiles(annee As Integer, Optional Fete As Integer = 0) 'Frédéric Sigonneau 'Le dimanche de Pâques est calculé à l'aide de l'algorythme 'utilisé par la fonction FirstDayOfEaster, ce qui rend cette fonction "autonome" 'mais limite sa validité (2099) Dim LPaq As Double, JAsc As Double, LPent As Double, DP As Double, D As Integer
If annee > 2099 Or annee < 1900 Then LesFetesMobiles = CVErr(xlErrValue) Exit Function End If 'Modification LeSurcitaire 'Pour suppression du Lundi de pentecote If annee >= 2005 Then LPent = 0 Exit Function End If
'algorythme de la fonction FirstDayOfEaster (site Cheap Pearson) 'pour le calcul du dimanche de Pâques D = (((255 - 11 * (annee Mod 19)) - 21) Mod 30) + 21 DP = DateSerial(annee, 3, 1) + D + (D > 48) + 6 - _ ((annee + annee 4 + D + (D > 48) + 1) Mod 7)
LPaq = DP + 1 JAsc = DP + 39 LPent = DP + 50
Select Case Fete Case 1: LesFetesMobiles = JAsc Case 2: LesFetesMobiles = LPent Case Else: LesFetesMobiles = LPaq End Select End Function
-- enlever lesurcitaire La Vie n'est rien sans la joie de vivre
