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

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

Nicolas JACQUIN

XLDnaute Accro
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

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)...
Trier par date Trier par votes
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
Solution
re, ça fonctionne impécable.
Tu aurais juste une idée pour mon module Mod_soleil, j'ai fait une correction +2 heures mais ça va me poser problème aussi. Avec ce que j'ai fait ça colle mais plus tard ça n'ira plus, merci
 
Vote positif 0 Vote négatif
Nicolas JACQUIN à dit:
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
Cliquez pour agrandir...
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..
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
2 K
un internaute
U
  • Question Question
Microsoft 365 Simplification de code
Réponses
1
Affichages
1 K
GADENSEB
G
  • Question Question
eurreur dans un code de filtration
Réponses
7
Affichages
2 K
geraldvc
G
M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
35 K
MichelXld
M
M
[REF] Wiki 1 de MichelXld (Généralités Excel)
Réponses
6
Affichages
60 K
Le_Phénomène
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…