Aller au contenu
Le Web des Cheminots

Fêtes Mobiles Chrétiennes


Messages recommandés

Publication:

Un petit programme réalisé en vb script:

http://msdn.microsoft.com/library/default....tml/vbswhat.asp

Pour télécharger directement les fichiers, consultez:

Microsoft Windows Script 5.6 (Windows 9x, Me, NT4)

ou

Microsoft Windows Script 5.6 (Windows 2000, XP)

http://msdn.microsoft.com/library/default....list/webdev.asp

LE SCRIPT:

Option explicit

'Les Variables'

Dim AnDepart,DateTrav,DateDepart

Dim jour,Mois

Dim c, n, k, i, j, l, m, d, y

Dim Paques, LundiPaques, Cendres, Careme, Passion, Rameaux, Ascension, _

Pentecote, Trinite, FeteDieu, SacreCoeur

'Gestion si erreur'

On error resume next

'Demande de l'année'

AnDepart = Inputbox("Entrez l'année s.v.p. (2 ou 4 chiffres)" & vbCrLF &  _

"(4 chiffres si millénaire different de 2000 )", _

"Calcul des fêtes mobiles chrétiennes")

'Si DateDepart sur deux chiffres on rajoute 2000

if len (AnDepart) = 2 then AnDepart = 2000 + AnDepart

'Si un valeur correcte

if AnDepart <> "" then

'Appel de la fonction de calcul des dates'

CalculFetesMobiles()

'Réponse

msgbox "Les Cendres :  " & Cendres & vbCrLF & _

"Premier dimanche de Carême :  " & Careme & vbCrLF &  _

"La Passion :  " & Passion & vbCrLF &  _

"Les Rameaux :  " & Rameaux & vbCrLF &  _

"Paques :  " & Paques & vbCrLF &  _

"Lundi de Paques :  " & LundiPaques & vbCrLF &  _

"Ascension :  " & Ascension & vbCrLF &  _

"Pentecôte :  " & Pentecote & vbCrLF &  _

"Trinité :  " & Trinite & vbCrLF &  _

"Fête-Dieu :  " & FeteDieu & vbCrLF &  _

"Sacré-Coeur :  " & SacreCoeur, _

vbinformation, "Les dates des fêtes mobiles chrétiennes pour l'année " & Andepart

'-----------------------------------------------------------------------------------

'La fonction de calcul des fêtes mobiles chrétiennes

Function CalculFetesMobiles()

Dim a, b, C, P, E, F, g, h, i,r

    ' routine pour déterminer la date de Paques

    Y = AnDepart

    a = fmod(Y, 19)

    b = Int(Y / 100)

    C = fmod(Y, 100)

    P = Int(b / 4)

    E = fmod(b, 4)

    F = Int((b + 8) / 25)

    g = Int((b - F + 1) / 3)

    h = fmod(19 * a + b - P - g + 15, 30)

    i = Int(C / 4)

    K = fmod(C, 4)

    r = fmod(32 + 2 * E + 2 * i - h - K, 7)

    N = Int((a + 11 * h + 22 * r) / 451)

    M = Int((h + r - 7 * N + 114) / 31)

    D = fmod(h + r - 7 * N + 114, 31) + 1

   

    '---------------------------------------

    'Paques

    Paques =DateSerial(Y, M, D)

    DateTrav = Paques

    DateDepart = Paques

    'Nom du jour et du mois

    TrouveNom

    'Jour de paques

    Paques = Jour & " " & D & " " & Mois &  " " & Y

    '---------------------------------------

    'Lundi de Paques

    DateTrav = DateAdd("d", 1, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    LundiPaques = Jour & " " & D & " " & Mois &  " " & Y   

    '---------------------------------------

    'Cendres

    DateTrav = DateAdd("d", -46, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    Cendres = Jour & " " & D & " " & Mois &  " " & Y       

    '---------------------------------------

    'Premier dimanche de carême

    DateTrav = DateAdd("d", -42, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    Careme = Jour & " " & D & " " & Mois &  " " & Y 

      '---------------------------------------

    'La passion

    DateTrav = DateAdd("d", -14, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    Passion = Jour & " " & D & " " & Mois &  " " & Y 

      '---------------------------------------   

    'Les Rameaux

    DateTrav = DateAdd("d", -7, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    Rameaux = Jour & " " & D & " " & Mois &  " " & Y 

      '---------------------------------------   

    'Ascension

    DateTrav = DateAdd("d", 39, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    Ascension = Jour & " " & D & " " & Mois &  " " & Y 

      '---------------------------------------   

    'Pentecote

    DateTrav = DateAdd("d", 49, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    Pentecote = Jour & " " & D & " " & Mois &  " " & Y 

      '---------------------------------------   

    'Trinite

    DateTrav = DateAdd("d", 56, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    Trinite = Jour & " " & D & " " & Mois &  " " & Y 

      '---------------------------------------   

    'Fete-Dieu

    DateTrav = DateAdd("d", 63, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    FeteDieu = Jour & " " & D & " " & Mois &  " " & Y 

      '---------------------------------------   

    'Sacré-Coeur

    DateTrav = DateAdd("d", 68, DateDepart)

    D=DatePart("d", DateTrav)

    'Nom du jour et du mois

    TrouveNom

    'Jour

    SacreCoeur = Jour & " " & D & " " & Mois &  " " & Y 

 

End Function

Function fmod(a, b)

 

    fmod = (a - b * Int(a / b))

 

End Function

'------------------------------------------------------------------------'

'Fonction pour trouver le nom du jour de la semaine'

Function TrouveNom()

dim Jsem

Jsem=(weekday(DateTrav))

select case Jsem

case 1 Jour = "Dimanche"

case 2 Jour = "Lundi"

case 3 Jour = "Mardi"

case 4 Jour = "Mercredi"

case 5 Jour = "Jeudi"

case 6 Jour = "Vendredi"

case 7 Jour = "Dimanche"

end select

'------------------------------------------------------------------------'

'Fonction pour trouver le nom du mois'

dim Lemois

Lemois=(month(DateTrav))

select case Lemois

case 1 Mois=("Janvier")

case 2 Mois=("Fevrier")

case 3 Mois=("Mars")

case 4 Mois=("Avril")

case 5 Mois=("Mai")

case 6 Mois=("Juin")

case 7 Mois=("Juillet")

case 8 Mois=("Aout")

case 9 Mois=("Septembre")

case 10 Mois=("Octobre")

case 11 Mois=("Novembre")

case 12 Mois=("Decembre")

end select

end Function

else

end if

:Smiley_18:

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer.