1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic

CADEAU Position de la Lune et ses phases [Résolu]

Signaler
Messages postés
188
Date d'inscription
mercredi 12 octobre 2005
Statut
Membre
Dernière intervention
19 novembre 2011
 -
Messages postés
2
Date d'inscription
vendredi 23 juin 2006
Statut
Membre
Dernière intervention
16 janvier 2009
 -
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
A voir également:

6 réponses

Réponse 1 / 6
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
 74
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 être de type Integer et pas Date

Pas mal de boulot avant que ça fonctionne vraiment ...
3
Merci
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 195 internautes nous ont dit merci ce mois-ci

Réponse 2 / 6
Messages postés
233
Date d'inscription
mercredi 26 février 2003
Statut
Membre
Dernière intervention
21 février 2009
 2
Bonjour
Pas mal
Par contre il faut mettre en commentaire la ligne Call Paques(LAnnee)
Réponse 3 / 6
Messages postés
188
Date d'inscription
mercredi 12 octobre 2005
Statut
Membre
Dernière intervention
19 novembre 2011
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
Réponse 4 / 6
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
 74
Salut
Pourquoi ne postes-tu pas ce code comme une source plutôt que sur le forum ?
Complète-le avec une simple application de démo, ça serait plus sympa.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Champion du monde de boule de cristal - 2005
Le savoir est la seule matière qui s'accro
Réponse 5 / 6
Messages postés
188
Date d'inscription
mercredi 12 octobre 2005
Statut
Membre
Dernière intervention
19 novembre 2011
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.
Réponse 6 / 6
Messages postés
2
Date d'inscription
vendredi 23 juin 2006
Statut
Membre
Dernière intervention
16 janvier 2009
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
Posez votre question