Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 calcul de l'heure quand le soleil est au Zénith

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Bonjour à tous,

Avec chatGPT, j'ai fait une approche sur le calcul de l'heure quand le soleil est au Zénith, mais pas bon, mon format reçu n'est pas celui souhaité.

Le résultat est en cellule "B20"



Je ne sais pas si c'est juste une histoire de format ou de conversion, je devrais avoir 14h18m à une ou deux minutes prêt.

VB:
Function ZenithTime(ByVal Date_ As Date, ByVal Longitude As Double) As Double

            A = Year(Range("B1"))
            M = Month(Range("B1"))
            J = ActiveCell.Value
            vdate = DateSerial(A, M, J)

    ' Variables
    Dim n As Double ' Nombre de jours depuis le 1er janvier de l'année
    Dim B As Double ' Correction pour l'équation du temps
    Dim EoT As Double ' Équation du temps en minutes
    Dim SolarNoon As Double ' Midi solaire en heures

    ' Nombre de jours depuis le début de l'année
    n = DateSerial(Year(A), Month(M), Day(J)) - DateSerial(Year(A), 1, 1) + 1
  
    ' Calcul de l'équation du temps (EoT)
    B = (n - 81) * (360 / 365)
    EoT = 9.87 * Sin(2 * Application.WorksheetFunction.Radians(B)) - 7.53 * Cos(Application.WorksheetFunction.Radians(B)) - 1.5 * Sin(Application.WorksheetFunction.Radians(B))
  
    ' Calcul de l'heure du zénith solaire (en heures)
    SolarNoon = 12 + (4 * Longitude - EoT) / 60
  
    ' Retourner l'heure du zénith en heures décimales
    ZenithTime = SolarNoon
End Function

Sub testzenith()

Cells(20, 2) = ZenithTime(vdate, -3.36667)

End Sub

J'ai pris ma position sur Lorient.

Merci à tous
Nicolas
 

Pièces jointes

  • New Calendrier v2 (1).xlsm
    134.4 KB · Affichages: 7
Solution
ca donnerait ceci:
VB:
'***********************************************
Function ZenithTime(ByVal vdate As Date, ByVal Longitude As Double) As Date
    ' Variables
    Dim n As Double ' Nombre de jours depuis le 1er janvier de l'année
    Dim B As Double ' Correction pour l'équation du temps
    Dim EoT As Double ' Équation du temps en minutes
    Dim SolarNoon As Double ' Midi solaire en heures
    Dim DateHe As Date 'date du passage à l'heure d'été
    Dim DateHh As Date 'date du passage à l'heure d'hiver
  
    DateHe = DateSerial(2024, 3, 31)
    DateHh = DateSerial(2024, 10, 28)
    If vdate >= DateHe And vdate < DateHh Then
        He = TimeSerial(2, 0, 0)
    Else
        He = TimeSerial(1, 0, 0)
    End If
  
    A = Year(vdate)...

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Re,
dans module Mod_Soleil, j'ai fais un correctif à la va que j'te pousse, mais ça va s'en doute me bloquer comme je disais précédemment.

VB:
'***********************************************
Function ConvertiDateJulienne(DateJulienne As Double, Optional M)
    '***********************************************
    Dim D As Double
    Dim Heures As Double
    Dim Minutes As Integer
    Dim secondes As Integer
    Dim correction_heure As Integer
    '1 jour = 86400 secondes
    '***********************************************
   
    correction_heure = 2 '(UTC+2)
   
    D = (86400 * (DateJulienne - Fix(DateJulienne)))
    '
    Heures = Int(D / 3600)
    Minutes = Int((D - (3600 * Heures)) / 60)
    secondes = D - (3600 * Heures) - (60 * Minutes)
    'Le jour julien commence à 12H
    Heures = (12 + Heures) Mod 24
    '
    If DateJulienne - Fix(DateJulienne) >= 0.5 Then
        DateJulienne = DateJulienne + 1
    End If
    '01/01/1900 12:00:00 = 2415021
    If IsMissing(M) Then
        ConvertiDateJulienne = _
                   DateAdd("d", Fix(DateJulienne) - 2415021, "01/01/1900") & " " & _
                   IIf(Int(Heures) = 0, "", Format(Int(Heures + correction_heure), "0#h ")) & _
                   IIf(Int(Minutes) = 0, "00m", Format(Int(Minutes), "0#m ")) & _
                   IIf(Int(secondes) = 0, "", Format(Int(secondes), "0#s "))
    Else
        ConvertiDateJulienne = _
                   DateAdd("d", Fix(DateJulienne) - 2415021, "01/01/1900") & " " & _
                   IIf(Int(Heures) = 0, "", Format(Int(Heures), "0#h "))
    End If
End Function
 

vgendron

XLDnaute Barbatruc
ca donnerait ceci:
VB:
'***********************************************
Function ZenithTime(ByVal vdate As Date, ByVal Longitude As Double) As Date
    ' Variables
    Dim n As Double ' Nombre de jours depuis le 1er janvier de l'année
    Dim B As Double ' Correction pour l'équation du temps
    Dim EoT As Double ' Équation du temps en minutes
    Dim SolarNoon As Double ' Midi solaire en heures
    Dim DateHe As Date 'date du passage à l'heure d'été
    Dim DateHh As Date 'date du passage à l'heure d'hiver
  
    DateHe = DateSerial(2024, 3, 31)
    DateHh = DateSerial(2024, 10, 28)
    If vdate >= DateHe And vdate < DateHh Then
        He = TimeSerial(2, 0, 0)
    Else
        He = TimeSerial(1, 0, 0)
    End If
  
    A = Year(vdate)
    Pi = WorksheetFunction.Pi()
    ' Nombre de jours depuis le début de l'année
    n = vdate - DateSerial(A, 1, 1) + 1
  
    ' Calcul de l'équation du temps (EoT)
    'Source du calcul: https://www.techno-science.net/definition/6567.html
  
    B = (2 * Pi * (n - 81) / 364) 'pi est en radian ==> B est déjà en radian
    EoT = -9.87 * Sin(2 * B) + 7.53 * Cos(B) + 1.5 * Sin(B)
  
    ' Calcul de l'heure du zénith solaire (en heures) 'c'est ici que ca doit coincer
    SolarNoon = 12 + 4 * Longitude + EoT  ' * 60 + EoT '* 60 '/60 ?
  
    'https://webetab.ac-bordeaux.fr/Pedagogie/Physique/TPE/midi.htm
    'HEURE LEGALE = HEURE SOLAIRE + CORRECTION LONGITUDE + 1 h (ou 2 l'été) + CORRECTION "EQUATION DU TEMPS"
    HS = TimeSerial(12, 0, 0)
    CL = TimeSerial(0, 4 * Longitude, 0)
  
  
    HL = HS + CL + He + TimeSerial(0, EoT, 0)
  
    ' Retourner l'heure du zénith en heures décimales
    ZenithTime = Format(HL, "hh:mm:ss")
End Function

Sub testzenith()
    MsgBox ZenithTime(DateSerial(2024, 6, 21), 3.36667)
End Sub
 

vgendron

XLDnaute Barbatruc
Pour info, j'ai placé ma correction là, mais n'en suis pas sûre du tout, le résultat était bon, du coup j'en suis resté là mais je sais qu'à un moment ça collera plus
c'est quand " à un moment ca collera plus" ??
si tu sais déjà QUAND ca ne collera plus, tu sais sans doute pourquoi..et donc, la correction à apporter devrait s'imposer.. non?

Note: j'ai regardé ton code..
il y en a un peu partout..
et c'est quoi ce type perso "HMS" ?? tu redéfinis le format date ??

idem pour le tableau des fetes..
pourquoi séparer jour et mois dans deux colonnes différentes?
suffit de 2 colonnes. (comme dans n'importe quel almanach)
Prénom / Date (au format jj mmmm)
et pour retrouver le jour et le mois, suffit d'utiliser les fonctions Day et Month

ce tableau devrait etre sous forme de table structurée.. ce serait plus simple à traiter: plus de do while loop..
 

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Re, le Mod_Soleil est de jm.andryszak qui a bien été sympa de m'aider, mais son code avait 2 heures de moins, c'est pour ça que j'ai fais ce correctif, donc je pense bien que fin d'année je risque d'avoir encore un décalage d'une heure au moins.

Pour ce qui est de la feuille la FichFetes, c'est dysorthographie qui m'avait apporté son aide à l'époque, ça fait plusieurs années déjà.

Merci
 

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD

Bonjour vgendron,
si tu as des idées d'améliorations, je suis preneur, pas de soucis.
Tu en as déjà fait beaucoup je t'en remercie mais n'hésite pas
Merci
Nico
 

vgendron

XLDnaute Barbatruc
Hello
oui, il y a pas mal d'améliorations à effectuer
1) sur le formulaire en lui meme
il faut absolument utiliser des noms explicits pour les controls
avec tous les labels qui existent, on ne sait pas lequel sert à quoi==> du coup, le code est dur à comprendre
2) rassembler ces controls dans des frames

3) dans les macros
quelle est la différence entre la fonction "recup_jour " et la fonction "create_calendrier" ?
dans les deux, il y a des boucles inutiles dans des boucles... le code passe son temps à tourner pour rien..

4) position du code
les macros de tests devraient etre rassemblées dans un module "mTest"
les macros sont mieux dans un module standard plutot que dans le code de la feuille
5) dans beaucoup de macros, tu passes ton temps à recrééer une date à partir du jour, mois année de la cellule active alors que la date est passée en paramètre (target)..

bref... pas mal de boulot de clarification et simplification
je reviens vers toi un peu plus tard
 

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Re,

merci de ton retour, je sait que c'est le fouillis, même moi j'y est du mal à mi retrouver des fois.
Je suis pas aussi pro que vous tous, je bricole un peu comme je peux

Je vais essayer de reprendre point par point,

1) Renommer chaque labels pour mieux comprendre.
2) ok, j'avais commencé
3) "recup_jour ", récupère le numéro du jour au démarrage du classeur pour le colorer, soit ci-dessous le 13.



et le "create_calendrier" est juste pour la création du calendrier de A à Z.

4) je passe, je sait que c'est que c'est le bazarre
5) comme je disais, je suis loin d'être un as, mais pour moi ça paraissait logique vu que je récupère toutes mes infos de la cellule sélecté (target).

Pour moi c'est juste un petit loisir à heure perdue.

J'avais quelques modifs entre temps, mais juste visuel.
 

Pièces jointes

  • New Calendrier v2.xlsm
    149.3 KB · Affichages: 2

vgendron

XLDnaute Barbatruc
Hello
ci jointe une version avec pas mal de modifs

1) les fetes sont dans une table strucuturée ==> plus besoin des colonnes Jour et Mois, il suffit de mettre la date de la fete (l'année importe peu)

2) le formulaire:
j'ai renommé tous les labels avec des noms explicites: (et corrigé le code en conséquence)
ex: Lbl_CoeffAM1==> label du coefficient du matin de la ville 1
Lvl_BMAM1 ==> BasseMer Matin ville 1......
==> du coup, je ne comprend pas.. je me retrouve avec des labels qui ne sont plus utilisés.. tu as changé quelque chose depuis le tout premier fichier??
==> les labels qui restent vides sur le formulaire.. on en fait quoi. on les supprime ou on remet le code qui les remplissait??

3) Module soleil
j'ai vu que tu faisais la correction heure d'été dans la fonction : ConvertiDateJulienne
j'ai supprimé cette correction, et l'ai mise dans la fonction LeverCoucherSoleil (en mettant 1 ou 2 selon la date: sur le meme principe que dans le calcul de l'heure du zenith)
à vérifier que ca donne toujours le bon résultat


j'ai supprimé des boucles inutiles dont je t'ai parlé
 

Pièces jointes

  • New Calendrier v3.xlsm
    153.4 KB · Affichages: 1
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…