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

Nicolas JACQUIN · 12 Août 2024

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

vgendron · 12 Août 2024

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 · 14 Août 2024

vgendron à dit:
Question
le rond noir et le rond blanc ==> lequel est nouvelle lune ou Pleine lune?
si il y a inversion (ce que je pense) il te suffit d'inverser dans le select case, les valeurs 152 et 153

Oui effectivement, désolé.
Merci encore pour tout
Nico

Nicolas JACQUIN · 14 Août 2024

Re, si je peux me permettre une dernière question et après j'arrête 😕 ,
serait t'il possible d'avoir la différence d'ensoleillement entre 1 date sélectée et le jour d'avant
exemple (- 3 min) ou (+ 2 min).

voici le fichier tel qu'il est

Merci

vgendron · 14 Août 2024

Je pense qu'il "suffit" de faire les calculs de lever et coucher et ensoleillement de la date -1

MAIS les fonctions liées au soleil sont à revoir
il faudrait UNE fonction qui calcule le lever et coucher d'une date==> LeverCoucherSoleil ==> elle retourne une chaine de caractères à mettre en variable publique

PUIS des fonctions qui font l'extraction simple du résultat de la fonction précédente
ExtractLever
ExtractCoucher
Ensoleillement
Ces 3 fontions NE METTENT PAS à jour les différents label
seulement les variables publiques LeverTU, CoucherTU

c'est une autre fonction qui le fait

Nicolas JACQUIN · 14 Août 2024

ben je sèche alors, merci de toutes ton aide.

vgendron · 14 Août 2024

tu as pourtant tous les éléments
voici l'algo qu'il faudrait suivre

1) tu selectionnes une date
2) tu calcules LeverCoucherSoleil (Date-1) => Retour de la fonction = string qui contient lever et coucher
3) tu extrais Lever et Coucher (fonction modifié pour ne plus les mettre dans le formulaire)
4) tu calcules l'ensoleillement ==> tu sauvegardes dans une variable publique

5) tu calcules LeverCoucherSoleil (Date) => Retour de la fonction = string qui contient lever et coucher
6) tu extrais Lever et Coucher (fonction modifiée pour ne plus les mettre dans le formulaire)
7) tu calcules l'ensoleillement ==> tu sauvegardes dans une variable publique
8) tu remplis le formulaire avec les les vairiables LeverTu, CouherTU...ensoleillement
tu calcules l'évoluton de l'ensoleillement que tu mets dans le formulaire

OU ALORS...dans le fichier, tu créées une table avec toutes les données de tous les jours du mois, voire de l'année
ainsi.. le formulaire ne fait plus de calcul.. il vient juste récupérer les infos.. comme il le fait pour les marées.

vgendron · 14 Août 2024

Ca donne ca

Nicolas JACQUIN · 14 Août 2024

vgendron à dit:
Ca donne ca

Merci,
(- 3 min) ou (+ 2 min) ça aurait été plus joli 🤣 🤣
C'est bien merci à toi.
Nico

vgendron · 14 Août 2024

suffit de changer le format d'affichage du résultat

VB:

Forme.dif_ensoleil = "(" & IIf(EnsolPréc > EnsolJour, "-", "+") & Format(Minute(EnsolPréc - EnsolJour), "00") & " min)"

Nicolas JACQUIN · 14 Août 2024

vgendron à dit:
suffit de changer le format d'affichage du résultat

VB:

Forme.dif_ensoleil = "(" & IIf(EnsolPréc > EnsolJour, "-", "+") & Format(Minute(EnsolPréc - EnsolJour), "00") & " min)"

Vous me bluffé à chaque fois, j'ai essayé des choses pourtant

Nicolas JACQUIN · 15 Août 2024

Bonjour vgendron,
je retouche encore et revient une dernière fois sur le sujet, est ce qu'il y a moyen de retirer les ( :00 )
sur les heures soleils, j'essaie de réduire en l'argeur l'userform.

parce que j'ai bricolé ça à intégrer encore, oui encore 🤣 😉

VB:

Sub JoursRestantsAvantProchaineSaison()
    Dim DateAuj As Date
    Dim DatePrintemps As Date
    Dim DateEte As Date
    Dim DateAutomne As Date
    Dim DateHiver As Date
    Dim ProchaineSaison As Date
    Dim JoursRestants As Long

    ' Date actuelle
    DateAuj = Date

    ' Définir les dates de début des saisons pour l'année en cours
    DatePrintemps = DateSerial(year(DateAuj), 3, 20)
    DateEte = DateSerial(year(DateAuj), 6, 21)
    DateAutomne = DateSerial(year(DateAuj), 9, 23)
    DateHiver = DateSerial(year(DateAuj), 12, 21)

    ' Déterminer la prochaine saison
    If DateAuj < DatePrintemps Then
        ProchaineSaison = DatePrintemps
        Message = "Le Printemps"
    ElseIf DateAuj < DateEte Then
        ProchaineSaison = DateEte
        Message = "l'Été"
    ElseIf DateAuj < DateAutomne Then
        ProchaineSaison = DateAutomne
        Message = "l'Automne"
    ElseIf DateAuj < DateHiver Then
        ProchaineSaison = DateHiver
        Message = "l'Hiver"
    Else
        ' Si la date actuelle est après le début de l'hiver, la prochaine saison est le printemps de l'année suivante
        ProchaineSaison = DateSerial(year(DateAuj) + 1, 3, 20)
    End If

    ' Calculer les jours restants
    JoursRestants = ProchaineSaison - DateAuj

    ' Afficher le résultat
    'MsgBox "Il reste " & JoursRestants & " jours avant la prochaine saison (" & Format(ProchaineSaison, "dd mmmm yyyy") & ")(" & Message & ")."
    MsgBox "Il reste " & JoursRestants & " jours avant " & Message & " ( le " & Format(ProchaineSaison, "dd mmmm yyyy") & " )."
End Sub

Merci
Nico

vgendron · 16 Août 2024

Hello
il va falloir te familiariser avec "format()"
les variables qu'on affiche dans le module soleil (LeverTU, CoucherTU, Zenith....) sont déclarées en format "Date" (jour mois annee, heure minute seconde)
format permet d'afficher ce que tu veux
format(LeverTU,"dd mm yyyy") ==>15 08 2024
format(LeverTU,"ddd mm yyyy")==>Lun 08 2024
format(LeverTU,"ddd dd mm yyyy")==> Lun 15 08 2024
format(LeverTU,"ddd dd mmm yyyy")==>Lun 15 Aout 2024

format(LeverTU,"hh:mm:ss")==> 06:50:00
format(LeverTU,"hh:m")==>06:50

etc etc...

Nicolas JACQUIN · 16 Août 2024

vgendron à dit:
Hello
il va falloir te familiariser avec "format()"
les variables qu'on affiche dans le module soleil (LeverTU, CoucherTU, Zenith....) sont déclarées en format "Date" (jour mois annee, heure minute seconde)
format permet d'afficher ce que tu veux
format(LeverTU,"dd mm yyyy") ==>15 08 2024
format(LeverTU,"ddd mm yyyy")==>Lun 08 2024
format(LeverTU,"ddd dd mm yyyy")==> Lun 15 08 2024
format(LeverTU,"ddd dd mmm yyyy")==>Lun 15 Aout 2024

format(LeverTU,"hh:mm:ss")==> 06:50:00
format(LeverTU,"hh:m")==>06:50

etc etc...

Bonjour,

j'ai essayé mais j'arrive pas, je suis vraiment quiche 😕 😕

TooFatBoy · 16 Août 2024

Nicolas JACQUIN à dit:
je retouche encore et revient une dernière fois sur le sujet, est ce qu'il y a moyen de retirer les ( :00 )
sur les heures soleils, j'essaie de réduire en l'argeur l'userform.

Dans la macro que tu donnes, je ne vois rien qui écrive dans un Userform. 🤔
Mais j'ai peut-être encore lu entre les lignes... 😓

Nicolas JACQUIN · 16 Août 2024

TooFatBoy à dit:
Mais j'ai peut-être encore lu entre les lignes... 😓

Salut l'ami,

oui je pense 🤣 😉 😉 , le principale du code et dans (Worksheet_SelectionChange)(Calendrier)
si tu avais ouvert le fichier 😉😉

je le rejoint.
Amicalement
Nico

TooFatBoy · 16 Août 2024

Nicolas JACQUIN à dit:
oui je pense 🤣 😉 😉 , le principale du code et dans (Worksheet_SelectionChange)(Calendrier)
si tu avais ouvert le fichier 😉😉

Ok, donc tu as posté un code qui en fait n'avait rien à voir avec le problème de format... 👍
😂😂😂

Sur ce, à dieu camarade et bonne chance pour la suite.
🖖

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

Nicolas JACQUIN

XLDnaute Accro

Pièces jointes

vgendron

Nicolas JACQUIN

XLDnaute Accro

Nicolas JACQUIN

XLDnaute Accro

Pièces jointes

vgendron

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Accro

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Pièces jointes

Nicolas JACQUIN

XLDnaute Accro

vgendron

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Accro

Nicolas JACQUIN

XLDnaute Accro

vgendron

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Accro

Pièces jointes

TooFatBoy

XLDnaute Barbatruc

Discussions similaires

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

XLDnaute Accro

Pièces jointes

XLDnaute Accro

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency