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)...
Trier par date Trier par votes

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
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
 

Pièces jointes

  • New Calendrier v2.xlsm
    152.5 KB · Affichages: 3
Vote positif 0 Vote négatif

vgendron

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

vgendron

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

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
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
 
Vote positif 0 Vote négatif

vgendron

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

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Bonjour,

j'ai essayé mais j'arrive pas, je suis vraiment quiche
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
35 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…