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: 8
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)...

vgendron

XLDnaute Barbatruc
pour l'erreur, c'est corrigé ici
j'avais déclaré He comme une date au lieu d'un entier

pour le reste.. je regarde..
pour les labels qui restent, je pense qu'il s'agit effectivement des infos sur le soleil.. mais je ne comprend pas.. je ne vois pas le code qui les renseigne...
 

Pièces jointes

  • New Calendrier v3.xlsm
    161.4 KB · Affichages: 2

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
À tout hasard, est-ce que ce n'est pas mis à jour par un PQ ?
Salut mon Jacky , tu lis entre les lignes, j'ai répondu ci-dessus, le PQ pour moi à part ou tu sais pour moi c'est chinois .
Non je sais mes codes c'est un gros bordel désolé vraiment.
Toi tu sais que je suis loin d'être un boss dans le domaine, c'est juste pour s'occuper et j'aime malgré mes grosses embûches avec le sujet
 

vgendron

XLDnaute Barbatruc
Hello Toofat,
Seules les deux tables des marées sont mises à jour via PQ

Nicolas,
une V3
j'ai fait un gros travail de renommage des différents conrols et mise à jour du code pour exploiter les tables structurées

Sur le formulaie, j'ai remis tous les controls que j'ai vu passer au cours du post

niveau code, j'ai l'impression qu'il y a des fonctions redondantes
CoucherSoleil, CoucherDUsoleil, levercouchersoleil.....
soit les noms sont mal choisis, soit il y a des redondances inutiles

j'ai vu que pour le zenith, tu passais par la feuille "Lune" pour mettre le résultat avant de le mettre dans le formulaire... inutile..il vaut mieux le mettre directement dans le formulaire..
 

Pièces jointes

  • New Calendrier v3.xlsm
    155.6 KB · Affichages: 1
Dernière édition:

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
niveau code, j'ai l'impression qu'il y a des fonctions redondantes
CoucherSoleil, CoucherDUsoleil, levercouchersoleil.....

Oui, je pense que tu as raison, jm.andryszak m'a donner ces codes et bien qu'il soit plus précis que ceux que j'avais j'ai eu du mal à m'y retrouver

j'ai vu que pour le zenith, tu passais par la feuille "Lune" pour mettre le résultat avant de le mettre dans le formulaire... inutile..il vaut mieux le mettre directement dans le formulaire..

Là oui je plaide coupable, j'ai cherché la simplicité parce que j'étais embété par rapport au format heure/minute, je ne savais pas comment formuler.

Merci
 

vgendron

XLDnaute Barbatruc
Bon, voici une dernière version
j'ai supprimé les fonctions inutilisées
et supprimé des appels répétitifs à certaines fonctions
ex: quand tu selectionnes une date dans le calendrier, le calcul du lever et coucher de soleil était lancé 2 ou 3 fois...
 

Pièces jointes

  • New Calendrier v4.xlsm
    146.8 KB · Affichages: 5

vgendron

XLDnaute Barbatruc
Hello

Pour les phases lunaires..
les dates sont prises dans l'ordre du tableau
après;. si les libellés ne sont pas bons, il te suffit de modifier le texte des labels de gauche (Nouvelle lune, PremierQuartier, Pleine lune et Dernier Quartier)
 

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
les 4 premiers label avec statue et date sont pris sur la feuille lune, ça ok.
Mais le dernier label, feuille lune mais ?

VB:
            For i = 1 To .ListRows.Count
                Interval = DateDiff("d", vdate, .DataBodyRange(i, 2))
                If Interval > 1 Then
                    Texte = Hour(.DataBodyRange(i, 3)) & " h " & Minute(.DataBodyRange(i, 3)) & " min " & "dans " & Interval & " jours"
                ElseIf Interval = 1 Then
                    Texte = Hour(.DataBodyRange(i, 3)) & " h " & Minute(.DataBodyRange(i, 3)) & " min " & "demain"
                ElseIf Interval = 0 Then
                    Texte = Hour(.DataBodyRange(i, 3)) & " h " & Minute(.DataBodyRange(i, 3)) & " min " & "aujourd'hui"
                End If

                If Interval >= 0 Then
                    Select Case Asc(.DataBodyRange(i, 1))
                        Case 152
                           'Range("D17") = "Pleine Lune à " & Texte
                           Forme.Lbl_NextLune = "Pleine Lune à " & Texte
                        Case 130
                            'Range("D17") = "Premier Quartier à " & Texte
                            Forme.Lbl_NextLune = "Premier Quartier à " & Texte
                        Case 153
                            'Range("D17") = "Nouvelle Lune à " & Texte
                            Forme.Lbl_NextLune = "Nouvelle Lune à " & Texte
                        Case 131
                            'Range("D17") = "Dernier Quartier à " & Texte
                            Forme.Lbl_NextLune = "Dernier Quartier à " & Texte
                    End Select
                    Exit For
                End If
            Next i
 

vgendron

XLDnaute Barbatruc
D'après ce que je comprend, cette boucle que tu as faite (ou qu'on t'a faite) cherche le prochain évènement lunaire par rapport à la date sélectionnée..??
un coup ce sera pleine lune, un coup premier quartier.....
je ne comprend donc pas le problème..?
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…