Lever et coucher du soleil

Bonjour,

Je développe actuellement une présentation PowerPoint dont le fond d’écran devrait se modifier en fonction de l’heure (en gros, jour = bleu, nuit = noir).
Après de nombreuses recherches sur Internet, j’ai découvert une procédure VBA dont l’auteur réfère vers votre site web (codes-sources.commentcamarche.net/profile/user/VBbigineure).
S’il s’agit d’une erreur d’aiguillage, veuillez considérer cette demande comme nulle et non avenue.
Le problème est que les résultats calculés par la procédure diffèrent sensiblement de ceux calculés par le logiciel « Soleil » issu de votre site (voir ci-dessous). Mes connaissances en astronomie ne me permettent pas de situer les instructions qui conduisent à la différence de résultats. N'ayant pas trouvé la possibilité d'ajouter un fichier en annexe, le code est repris in extenso en fin de message. Il est adapté pour un environnement 64 bits (« PtrSafe »).
Puis-je solliciter votre aide pour ajuster la procédure afin d’obtenir des résultats en concordance avec la réalité.

D’avance, merci

GiHem
'Pour Bruxelles
'Lat = -4.403069
'Lon = 50.824501
'valeurs calculées par cette procédure le 3/11/2013
'Lever = 09:59
'Coucher = 22:15
'midi = 15,3883000666667
'valeurs calculées par le logiciel "Soleil" le 3/11/2013
'lever 07:38
'coucher 17:14
'midi 12:26

Code:

'Public PI As Double
Public Lon As Double, Lat As Double

Const k = 0.0172024
Const jm = 308.67
Const jl = 21.55
Const e = 0.0167
Const ob = 0.4091
Const PI = 3.14159265358979


'******************************************************************
'** Pour celui qui désirera plus de précision il lui faudra:
'1): calculer la déclinaison et l'équation du temps selon la date vraie, là
'    je détermine le nombre de jours depuis le
'    premier mars, les années bissextiles, ca fait déjà un jour d'erreur.
'2): Ne pas se contenter de constantes pour l'exentricité de l'orbite (e)
'    ni pour l'obliquité (Ob)
'******************************************************************

Declare PtrSafe Sub GetSystemTime Lib "kernel32" (lpSystemTime As HeureSyst)
' Ca, c'est pour déterminer l'ecart entre l'heure système et l'heure TU. grace a la function Delta.
Type HeureSyst
        GMTAnnee As Integer
        GMTMois As Integer
        GMTJourSemaine As Integer
        GMTJour As Integer
        GMTHeure As Integer
        GMTMinute As Integer
        GMTSeconde As Integer
        GMTMillisecondes As Integer
    End Type

Public Function DELTA() As String
Dim Tmp As Single
Dim SysTime As HeureSyst
Call GetSystemTime(SysTime)
Tmp = Time - (SysTime.GMTHeure / 24 + SysTime.GMTMinute / 1440 + SysTime.GMTSeconde / 86400)
' si les deux jours sont <>
If Tmp < 0 Then Tmp = Tmp + 24
If Tmp > 24 Then Tmp = Tmp - 24
DELTA = Tmp
End Function

' Hauteur du soleil au lever et au coucher
'Public Function CalculSol(Jou As Integer, Moi As Integer, Lon As Double, Lat As Double)
Public Sub CalculSol()
Dim Jou As Integer, Moi As Integer, CalculSol As String
Jou = Day(Now())
Moi = Month(Now())
Lat = -4.403069
Lon = 50.824501
Mo = Moi
Jo = Jou
dr = PI / 180
hr = PI / 12
ht = -50 / 60
ht = ht * dr
' Fuseau horaire et coordonnées géographiques
fh = Hour(DELTA)
La = Lat
Lo = Lon
La = La * dr
Lo = Lo * dr
' Date
If Mo < 3 Then Mo = Mo + 12
' Heure TU du milieu de la journée
h = 12 + (Lo / hr)
' Nombre de jours écoulés depuis le 1 Mars O h TU
j = Int(30.61 * (Mo + 1)) + Jo + (h / 24) - 123
'j = Now() - DateSerial(Year(Now()), 1, 1)

' Anomalie et longitude moyenne
m = k * (j - jm)
L = k * (j - jl)
' Longitude vraie
S = L + 2 * e * Sin(m) + 1.25 * e * e * Sin(2 * m)
' Coordonnées rectangulaires du soleil dans le repère équatorial
X = Cos(S): Y = Cos(ob) * Sin(S)
Z = Sin(ob) * Sin(S)

' Equation du temps et déclinaison
R = L
rx = Cos(R) * X + Sin(R) * Y
ry = -Sin(R) * X + Cos(R) * Y
X = rx
Y = ry
ET = Atn(Y / X)
DC = Atn(Z / Sqr(1 - Z * Z))

' Angle horaire au lever et au coucher
cs = (Sin(ht) - Sin(La) * Sin(DC)) / Cos(La) / Cos(DC)
If cs > 1 Then CalculSol = "Ne se lève pas": Exit Sub
If cs < -1 Then CalculSol = "Ne se couche pas": Exit Sub
If cs = 0 Then ah = PI / 2 Else ah = Atn(Sqr(1 - cs * cs) / cs)
If cs < 0 Then ah = ah + PI
' Lever du soleil
Pm = h + fh + (ET - ah) / hr
If Pm < 0 Then Pm = Pm + 24
If Pm > 24 Then Pm = Pm - 24
hs = Int(Pm)
Pm = 60 * (Pm - hs)
If Format(Pm, "00") = "60" Then Pm = Pm - 60: hs = hs + 1
lev = Format(hs, "00") & ":" & Format(Pm, "00")
' Coucher du soleil
Pm = h + fh + (ET + ah) / hr
If Pm > 24 Then Pm = Pm - 24
If Pm < 0 Then Pm = Pm + 24

hs = Int(Pm)
Pm = 60 * (Pm - hs)
If Format(Pm, "00") = "60" Then Pm = Pm - 60: hs = hs + 1
couch = Format(hs, "00") & ":" & Format(Pm, "00")
CalculSol = "Lever = " & lev & vbCrLf & "Coucher = " & couch & vbCrLf & "midi = " & h
Debug.Print CalculSol
'
'
'Pour Bruxelles
'Lat = -4.403069
'Lon = 50.824501
'valeurs calculées par cette procédure le 3/11/2013
'Lever = 09:59
'Coucher = 22:15
'midi = 15,3883000666667
'valeurs calculées par le logiciel "Soleil" le 3/11/2013
'lever 07:38
'coucher 17:14
'midi 12:26
'
'
End Sub

Bonjour,
je revendique complètement cette source...
En lisant rapidement je vois une erreur dans vos coordonnées, vous avez confondu Latitude et longitude.
Bonne journée

Bonjour,
Merci pour votre réponse.
Après correction de l'erreur de coordonnées, les heures sont correctes.

Votre site est très intéressant et enrichissant même si l'astronomie n'est pas ma tasse de thé.

Bonne journée

GiHem