Aller au contenu
Le Web des Cheminots

Fêtes Mobiles Chrétiennes


Invité ___

Messages recommandés

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:

Lien vers le commentaire
Partager sur d’autres sites

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.