CADEAU Position de la Lune et ses phasesRésolu

Question

Bonjour, Calculer la position de la Lune peut servir pour les fêtes spéciales (celles qui dépendent de Paques) d'un calendrier, la date de début et fin de l'horoscope chinois, les dates de plantation, d'arrachage ou de coupe dans une appli de jardinerie etc... Si besoin, prévoir les images des différentes phases de la lune. La variable de phase est à 2 niveaux : NomPhase et NomPhaseCourt suivant la taille de l'étiquette. Function QuartierLune(DateDuJour As String) Dim DateBase As Date, MaDate As Date, AgeLune As Long, Phase As Long, LAnnee As Integer If Right(CurDir, 5) <> "\Data" Then Chemin = CurDir + "\Data" Else Chemin = CurDir + "" End If Synodic = 29.53058867 MsParJour = 86400000 LAnnee = Val(Right(DateDuJour, 4)) MaDate = Val(DateDuJour) DateBase = DateSerial(2003, 7, 29) DiffDate = Abs(MaDate - DateBase) DiffEnMillis = DiffDate * 24 * 60 * 60 * 1000 Phase = Int((DiffEnMillis * 100) / (Synodic * MsParJour)) Do While Phase > 100 Phase = Phase - 100 Loop AgeLune = (Synodic * Phase) / 100 Call PhasesLune(Phase) JourAvantPL = Int((Synodic - AgeLune) + Synodic / 2) JourAvantNL = Int(Synodic - AgeLune) Call Paques(LAnnee) Msg = "Pourcentage passé de la Lune : " + CStr(Phase) + " %" + vbCrLf Msg = Msg + "Âge de la Lune : " + CStr(AgeLune) + " jours" + vbCrLf Msg = Msg + "Phase de la Lune : " + NomPhase + vbCrLf Msg = Msg + "Jours Avant la Pleine Lune : " + CStr(Abs(JourAvantPL)) + " jours" + vbCrLf Msg = Msg + "Jours Avant la Nouvelle Lune : " + CStr(Abs(JourAvantNL)) + " jours" + vbCrLf Msg = Msg + vbCrLf + "Paques le : " + CStr(LesPaques) QuartierLune = Msg End Function Function PhasesLune(Quartier As Long) If (Quartier >= 0 And Quartier <= 2.49) Then NomPhase = "Nouvelle Lune" NomPhaseCourt = "Nouvelle" + vbCrLf + "Lune" ImgLune = "L_NouvelleLune.bmp" ElseIf (Quartier >= 2.5 And Quartier <= 22.49) Then NomPhase = "Premier Croissant" NomPhaseCourt = "Premier" + vbCrLf + "Croissant" ImgLune = "L_CroissantDeb.bmp" ElseIf (Quartier >= 22.5 And Quartier <= 27.49) Then NomPhase = "Premier Quartier" NomPhaseCourt = "Premier" + vbCrLf + "Quartier" ImgLune = "L_DemiLuneDeb.bmp" ElseIf (Quartier >= 27.5 And Quartier <= 47.49) Then NomPhase = "Lune gibbeuse" NomPhaseCourt = "Lune" + vbCrLf + "Gibbeuse" ImgLune = "L_LuneGibbeuseDeb.bmp" ElseIf (Quartier >= 47.5 And Quartier <= 52.49) Then NomPhase = "Pleine Lune" NomPhaseCourt = "Pleine" + vbCrLf + "Lune" ImgLune = "L_PleineLune.bmp" ElseIf (Quartier >= 52.5 And Quartier <= 73.49) Then NomPhase = "Lune gibbeuse" NomPhaseCourt = "Lune" + vbCrLf + "Gibbeuse" ImgLune = "L_LuneGibbeuseFin.bmp" ElseIf (Quartier >= 73.5 And Quartier <= 77.49) Then NomPhase = "Dernier quartier" NomPhaseCourt = "Dernier" + vbCrLf + "quartier" ImgLune = "L_DemiLuneFin.bmp" ElseIf (Quartier >= 77.5 And Quartier <= 97.49) Then NomPhase = "Dernier croissant" NomPhaseCourt = "Dernier" + vbCrLf + "croissant" ImgLune = "L_CroissantFin.bmp" Else NomPhase = "Nouvelle Lune" NomPhaseCourt = "Nouvelle" + vbCrLf + "Lune" ImgLune = "L_NouvelleLune.bmp" End If End Function

cs_Jack · Accepted Answer

C'est encore moi

Beaucoup de dimensionnement manquant
Calcul sur les dates par terrible alors qu'il existe des fonctions toutes faites et en plus prennent en compte le format local des dates (Year, Day, DateDiff ...)
Manque de rigueur sur les type de variables : MaDate par exemple devrait &#234;tre de type Integer et pas Date

Pas mal de boulot avant que &#231;a fonctionne vraiment ...

FMatrix07 · Answer

Bonjour
Pas mal
Par contre il faut mettre en commentaire la ligne Call Paques(LAnnee)

whombat · Answer

Exact
C'est encore une autre fonction qui donne le jour de Paques et les Fêtes qui y sont liées. D'ailleurs la voici : 

NB : Le tableau TabDateFete a 5 niveaux 

        1 - La variable de la fête
        2 - Sa date
        3 - Si c'est férié (entre parenthèse lorsque c'est uniquement local)
        4 - si c'est un nom composé
        5 - Dans le cas ou c'est un nom composé, Le nom composé

Function Paques(Annee As Integer) As Date

    Dim var1, var2, var3, var4, var5, var6, var7

    var1 = Annee Mod 19 + 1
    var2 = (Annee \ 100) + 1
    var3 = ((3 * var2) \ 4) - 12
    var4 = (((8 * var2) + 5) \ 25) - 5
    var5 = ((5 * Annee) \ 4) - var3 - 10
    var6 = (11 * var1 + 20 + var4 - var3) Mod 30
     
    If (var6 25 And var1 > 11) Or (var6 24) Then
        var6 = var6 + 1
    End If
     
    var7 = 44 - var6
     
    If var7 < 21 Then
        var7 = var7 + 30
    End If
     
    var7 = var7 + 7
    var7 = var7 - (var5 + var7) Mod 7
         
    If var7 <= 31 Then
        LesPaques = DateValue(CStr(var7) & "/03/" & CStr(Annee))
    Else
        LesPaques = DateValue(CStr(var7 - 31) & "/04/" & CStr(Annee))
    End If

    TabDateFete(1, 1) = "Septuagésime"
    TabDateFete(1, 2) = LesPaques - 63
    TabDateFete(1, 3) = 0
    TabDateFete(1, 4) = 0
    TabDateFete(1, 5) = ""
    
    TabDateFete(2, 1) = "Sexagésime"
    TabDateFete(2, 2) = LesPaques - 56
    TabDateFete(2, 3) = 0
    TabDateFete(2, 4) = 0
    TabDateFete(2, 5) = ""

    TabDateFete(3, 1) = "Quinquagésime"
    TabDateFete(3, 2) = LesPaques - 49
    TabDateFete(3, 3) = 0
    TabDateFete(3, 4) = 0
    TabDateFete(3, 5) = ""
    
    TabDateFete(4, 1) = "MardiGras"
    TabDateFete(4, 2) = LesPaques - 47
    TabDateFete(4, 3) = 0
    TabDateFete(4, 4) = 1
    TabDateFete(4, 5) = "Mardi Gras"

    TabDateFete(5, 1) = "Cendres"
    TabDateFete(5, 2) = LesPaques - 46
    TabDateFete(5, 3) = 0
    TabDateFete(5, 4) = 0
    TabDateFete(5, 5) = ""
    
    TabDateFete(6, 1) = "Quadragésime"
    TabDateFete(6, 2) = LesPaques - 42
    TabDateFete(6, 3) = 0
    TabDateFete(6, 4) = 0
    TabDateFete(6, 5) = ""
    
    TabDateFete(7, 1) = "Reminiscere"
    TabDateFete(7, 2) = LesPaques - 35
    TabDateFete(7, 3) = 0
    TabDateFete(7, 4) = 0
    TabDateFete(7, 5) = ""
    
    TabDateFete(8, 1) = "Oculi"
    TabDateFete(8, 2) = LesPaques - 28
    TabDateFete(8, 3) = 0
    TabDateFete(8, 4) = 0
    TabDateFete(8, 5) = ""
    
    TabDateFete(9, 1) = "MiCareme"
    TabDateFete(9, 2) = LesPaques - 24
    TabDateFete(9, 3) = 0
    TabDateFete(9, 4) = 1
    TabDateFete(9, 5) = "Mi-Carême"
    
    TabDateFete(10, 1) = "Laetare"
    TabDateFete(10, 2) = LesPaques - 21
    TabDateFete(10, 3) = 0
    TabDateFete(10, 4) = 0
    TabDateFete(10, 5) = ""
    
    TabDateFete(11, 1) = "Passion"
    TabDateFete(11, 2) = LesPaques - 14
    TabDateFete(11, 3) = 0
    TabDateFete(11, 4) = 0
    TabDateFete(11, 5) = ""
    
    TabDateFete(12, 1) = "Rameaux"
    TabDateFete(12, 2) = LesPaques - 7
    TabDateFete(12, 3) = 0
    TabDateFete(12, 4) = 0
    TabDateFete(12, 5) = ""
    
    TabDateFete(13, 1) = "VendrediSaint"
    TabDateFete(13, 2) = LesPaques - 2
    TabDateFete(13, 3) = 1
    TabDateFete(13, 4) = 1
    TabDateFete(13, 5) = "Vendredi Saint (Alsace/Lorraine)"
    
    TabDateFete(14, 1) = "LesPaques"
    TabDateFete(14, 2) = LesPaques
    TabDateFete(14, 3) = 1
    TabDateFete(14, 4) = 1
    TabDateFete(14, 5) = "Pâques"
    
    TabDateFete(15, 1) = "LundiDePaques"
    TabDateFete(15, 2) = LesPaques + 1
    TabDateFete(15, 3) = 1
    TabDateFete(15, 4) = 1
    TabDateFete(15, 5) = "Lundi de Pâques"
    
    TabDateFete(16, 1) = "Quasimodo"
    TabDateFete(16, 2) = LesPaques + 7
    TabDateFete(16, 3) = 0
    TabDateFete(16, 4) = 0
    TabDateFete(16, 5) = ""
    
    TabDateFete(17, 1) = "Rogations"
    TabDateFete(17, 2) = LesPaques + 36
    TabDateFete(17, 3) = 0
    TabDateFete(17, 4) = 0
    TabDateFete(17, 5) = ""
        
    TabDateFete(18, 1) = "Ascension"
    TabDateFete(18, 2) = LesPaques + 39
    TabDateFete(18, 3) = 0
    TabDateFete(18, 4) = 0
    TabDateFete(18, 5) = ""
    
    TabDateFete(19, 1) = "Pentecôte"
    TabDateFete(19, 2) = LesPaques + 49
    TabDateFete(19, 3) = 0
    TabDateFete(19, 4) = 0
    TabDateFete(19, 5) = ""
    
    TabDateFete(20, 1) = "LundidePentecote"
    TabDateFete(20, 2) = LesPaques + 50
    TabDateFete(20, 3) = 1
    TabDateFete(20, 4) = 1
    TabDateFete(20, 5) = "Lundi de Pentecôte"
    
    TabDateFete(21, 1) = "Trinité"
    TabDateFete(21, 2) = LesPaques + 56
    TabDateFete(21, 3) = 0
    TabDateFete(21, 4) = 0
    TabDateFete(21, 5) = ""
    
    TabDateFete(22, 1) = "FeteDieu"
    TabDateFete(22, 2) = LesPaques + 60
    TabDateFete(22, 3) = 1
    TabDateFete(22, 4) = 1
    TabDateFete(22, 5) = "Fête Dieu"
    
    TabDateFete(23, 1) = "NouvelAn"
    TabDateFete(23, 2) = "01/01/" + Trim(Annee)
    TabDateFete(23, 3) = 1
    TabDateFete(23, 4) = 1
    TabDateFete(23, 5) = "Nouvel An"
    
    TabDateFete(24, 1) = "Victoire"
    TabDateFete(24, 2) = "05/08/" + Trim(Annee)
    TabDateFete(24, 3) = 1
    TabDateFete(24, 4) = 1
    TabDateFete(24, 5) = "Victoire de 1945"
    
    TabDateFete(25, 1) = "FeteNationale"
    TabDateFete(25, 2) = "14/07/" + Trim(Annee)
    TabDateFete(25, 3) = 1
    TabDateFete(25, 4) = 1
    TabDateFete(25, 5) = "Fête Nationale"
    
    TabDateFete(26, 1) = "Assomption"
    TabDateFete(26, 2) = "08/05/" + Trim(Annee)
    TabDateFete(26, 3) = 1
    TabDateFete(26, 4) = 0
    TabDateFete(26, 5) = ""
    
    TabDateFete(27, 1) = "Toussaint"
    TabDateFete(27, 2) = "01/11/" + Trim(Annee)
    TabDateFete(27, 3) = 1
    TabDateFete(27, 4) = 0
    TabDateFete(27, 5) = ""
    
    TabDateFete(28, 1) = "Armistice"
    TabDateFete(28, 2) = "11/11/" + Trim(Annee)
    TabDateFete(28, 3) = 1
    TabDateFete(28, 4) = 1
    TabDateFete(28, 5) = "Armistice de 1918"
    
    TabDateFete(29, 1) = "Noël"
    TabDateFete(29, 2) = "25/12/" + Trim(Annee)
    TabDateFete(29, 3) = 1
    TabDateFete(29, 4) = 1
    TabDateFete(29, 5) = "Noël"
    
    TabDateFete(30, 1) = "AboEsclMayotte"
    TabDateFete(30, 2) = "27/04/" + Trim(Annee)
    TabDateFete(30, 3) = 1
    TabDateFete(30, 4) = 1
    TabDateFete(30, 5) = "Ab. Esclavage (Mayotte)"
    
    TabDateFete(31, 1) = "AboEsclMartinique"
    TabDateFete(31, 2) = "22/05/" + Trim(Annee)
    TabDateFete(31, 3) = 1
    TabDateFete(31, 4) = 1
    TabDateFete(31, 5) = "Ab. Esclavage (Martinique)"
    
    TabDateFete(32, 1) = "AboEsclGuadeloupe"
    TabDateFete(32, 2) = "27/05/" + Trim(Annee)
    TabDateFete(32, 3) = 1
    TabDateFete(32, 4) = 1
    TabDateFete(32, 5) = "Ab. Esclavage (Guadeloupe)"
    
    TabDateFete(33, 1) = "AboEsclGuyane"
    TabDateFete(33, 2) = "10/06/" + Trim(Annee)
    TabDateFete(33, 3) = 1
    TabDateFete(33, 4) = 1
    TabDateFete(33, 5) = "Ab. Esclavage (Guyanne)"
    
    TabDateFete(34, 1) = "AboEsclRéunion"
    TabDateFete(34, 2) = "20/12/" + Trim(Annee)
    TabDateFete(34, 3) = 1
    TabDateFete(34, 4) = 1
    TabDateFete(34, 5) = "Ab. Esclavage (Réunion)"
    
    TabDateFete(35, 1) = "SaintEtienne"
    TabDateFete(35, 2) = "26/12/" + Trim(Annee)
    TabDateFete(35, 3) = 1
    TabDateFete(35, 4) = 1
    TabDateFete(35, 5) = "Saint Etienne (Saint Etienne (42))"
    
    TabDateFete(36, 1) = "SaintEloi"
    TabDateFete(36, 2) = "01/12/" + Trim(Annee)
    TabDateFete(36, 3) = 1
    TabDateFete(36, 4) = 1
    TabDateFete(36, 5) = "Saint Eloi (Metall. Nord / P. de Calais)"

    TabDateFete(37, 1) = "SaintBarbe"
    TabDateFete(37, 2) = "24/12/" + Trim(Annee)
    TabDateFete(37, 3) = 1
    TabDateFete(37, 4) = 1
    TabDateFete(37, 5) = "Sainte Barbe (Mines)"
    
End Function

cs_Jack · Answer

Salut
Pourquoi ne postes-tu pas ce code comme une source plut&#244;t que sur le forum ?
Compl&#232;te-le avec une simple application de d&#233;mo, &#231;a serait plus sympa.

Vala
Jack, MVP VB
NB : Je ne r&#233;pondrai pas aux messages priv&#233;s 

Champion du monde de boule de cristal - 2005
Le savoir est la seule mati&#232;re qui s'accro

whombat · Answer

C'est vrai que je n'avais pas pensé aux dates locales. Merci de me le rappeler. Je ferai plus, juré...
Je suis un petit en prog, autodidacte et faible.
Ces calculs représentent beaucoup de recherche, de compil, d'adaptation et de test pour moi. J'ai pensé que cela pourrait servir aux autres. DFe nombreux jours de gagnés avec juste un copier/coller.
Mais tout cela sans prétention. C'est pourquoi je n'ai pas eu l'idée de le proposer en source.

cs_jp0304 · Answer

vingtdious,  j'va essayé d'en faire quek chose de ton truck qui m'a l'air bien ficelé !
merci!
JP

le plaisir d'apprendre, de créer, de partager

CADEAU Position de la Lune et ses phases

6 réponses

Discussions similaires