XL 2021 Calendrier des marées info

[Nicolas JACQUIN]

Bonjour à tous,

A ceux qui ont le pied marin,

je voulais savoir s'il était possible de créer un calendrier des marées avec :
-les heures de marée Haute
-les heures de marée Basse

et éventuellement les coefs.

Je ne sais pas du tout si c'est possible, mais si certains ont déjà étudiés sur la chose je suis preneur.

Je sais qu'il y a plein de site en ligne qui donne ce que je veux, mais se serait pour compléter un calendrier
avec les phases lunaires, éphémérides ..........

Si ça peut aider je suis de la région Lorientaise (Bretagne)

En vous remerciant d'avance.

Nicolas

 

[Nicolas JACQUIN]

on est d'accord?
C'est la date du jour on affiche si maintenant la mère monte ou descend sans offre la possibilité de changer de date ?

Bonjour mon ami,

Oui c'est bien ça

merci

 

[dysorthographie]

Bonjour,
dis moi ce que tu en penses?

 

[Nicolas JACQUIN]

Bonjour,
Merci je vais regarder

 

[Nicolas JACQUIN]

Re dysorthographie,
Tu as fais un gros boulot encore, j'en demandais pas tant,
J'ai réussi à l'ouvrir une fois, mais après dès que je clic sur la date j'ai message d'erreur, et ça crash tous seul
Il y a plus les dates du coup

 

[dysorthographie]

Bonjour,
Que dit le message d'erreur. Si cela pose problème j'enlève le timer je trouvais ça rigolo d'avoir un suivi de la marrée journalière à la minute.

 

[Nicolas JACQUIN]

J'ai une erreur 13, incompatibilité de type
Je vois rien de plus ça crash
Le bouton marche pas, j'ai mi le tic à la fin du code Worksheet_SelectionChange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim I
    Dim Interval
    Dim texte
    Dim HZenith As String
    Dim EnsolPréc As Date
    Dim EnsolJour As Date
    Dim TS As ListObject

    Set TS = Sheets("Lune").ListObjects("t_Lune")

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("Calendrier")) Is Nothing Then Exit Sub
    If Not IsNumeric(Left(Target, 1)) Or Target = "" Then Exit Sub

    With Forme

        .Hauteur_basse_mer_am = "": .Hauteur_pleine_mer_am = "": .Hauteur_basse_mer_ap = "": .Hauteur_pleine_mer_ap = ""

        .Lbl_MaréeJour = "": .Lbl_MaréeJour.ForeColor = -2147483630

        A = Year(Range("B1")): M = Month(Range("B1")): j = Left(Target, Len(Target) - InStr(Target, " ") + 1)
        vdate = DateSerial(A, M, j)

        fete (vdate)
        Mareee (vdate)

        With TS
            For I = 1 To .ListRows.Count
                Interval = DateDiff("d", vdate, .DataBodyRange(I, 2))
                Debug.Print Interval
                If Interval > 1 Then
                    texte = Hour(.DataBodyRange(I, 3)) & " h " & Minute(.DataBodyRange(I, 3)) & " min " & "dans " & Interval & " jours"
                    Forme.Label86.Caption = "( par rapport à la date sélectée )"
                ElseIf Interval = 1 Then
                    texte = Hour(.DataBodyRange(I, 3)) & " h " & Minute(.DataBodyRange(I, 3)) & " min " & "demain"
                    Forme.Label86.Caption = "( par rapport à la date sélectée )"
                ElseIf Interval = 0 Then
                    texte = Hour(.DataBodyRange(I, 3)) & " h " & Minute(.DataBodyRange(I, 3)) & " min "
                    Forme.Label86.Caption = "( par rapport à la date sélectée )"
                End If

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

        .Lbl_Jour.Caption = WorksheetFunction.Proper(Format(vdate, "dddd")) & " " & Format(vdate, "dd mmmm yyyy")

        .Lbl_NumSem.Caption = "Semaine n° " & DatePart("ww", vdate, vbMonday, vbFirstFourDays)
        .Tag = vdate
       
        .Départements = "(56) Morbihan"
        .VILLES = "Hennebont"
'        .Dates = vdate
'        If Hour(Now) >= .Matin_Basse And Hour(Now) <= .Matin_Haute Then .Etatmare = "Etat de la marée ( Montante )"
'        If Hour(Now) >= .Après_Basse And Hour(Now) <= .Après_Haute Then .Etatmare = "Etat de la marée ( Montante )"
'        If Hour(Now) >= .Matin_Haute And Hour(Now) <= .Après_Basse Then .Etatmare = "Etat de la marée ( Descendante )"
'        If Hour(Now) >= .Après_Haute And Hour(Now) <= .Matin_Basse Then .Etatmare = "Etat de la marée ( Descendante )"
        .Lbl_PosJour.Caption = DatePart("y", vdate) & " ème jour de l'année."

        DateDebut = vdate: DateFin = CDate("31/12/" & (A))
        NbJours = DateDiff("d", DateDebut, DateFin)
        .Lbl_NbJourRestant.Caption = NbJours & " jours restant."

        I = 1
        While Month(TS.DataBodyRange(I, 2)) <> Month(vdate)
            I = I + 1
        Wend
        For j = 1 To 5 'pour les 5 controls de lunaison
            If Month(TS.DataBodyRange(I + j - 1, 2)) = Month(vdate) Then
                .Controls("Lbl_Lunaison" & j).Visible = True
                Select Case TS.DataBodyRange(I + j - 1, 1)
                    Case Chr(130)
                        .Controls("Lbl_Lunaison" & j).Caption = "Premier Quartier"
                    Case Chr(131)
                        .Controls("Lbl_Lunaison" & j).Caption = "Dernier Quartier"
                    Case Chr(152)
                        .Controls("Lbl_Lunaison" & j).Caption = "Nouvelle Lune"
                    Case Chr(153)
                        .Controls("Lbl_Lunaison" & j).Caption = "Pleine Lune"
                End Select

                .Controls("Lunaison" & j).Visible = True
                .Controls("Lunaison" & j).Caption = TS.DataBodyRange(I + j - 1, 2)
            Else
                .Controls("Lbl_Lunaison" & j).Visible = False
                .Controls("Lunaison" & j).Visible = False
            End If
        Next j

        ExtraireLevercoucherDuSoleil (vdate - 1)
        EnsolPréc = Ensoleil
        ExtraireLevercoucherDuSoleil (vdate)
        EnsolJour = Ensoleil

        'Forme.Lbl_LeverSoleil = "Lever du soleil" & vbTab & vbTab & LeverTU
        Forme.Lbl_LeverSoleil = "Lever du soleil" & vbTab & vbTab & Format(LeverTU, "hh:mm")
        With Worksheets("MaPosition")
            If .cells(2, 2) = "" Then Forme.Lbl_LeverSoleil = "Lever du soleil"
        End With

        'Forme.Lbl_CoucherSoleil = "Coucher du soleil" & vbTab & CoucherTU
        Forme.Lbl_CoucherSoleil = "Coucher du soleil" & vbTab & Format(CoucherTU, "hh:mm")
        With Worksheets("MaPosition")
            If .cells(2, 2) = "" Then Forme.Lbl_CoucherSoleil = "Lever du soleil"
        End With

        'Forme.Lbl_Ensoleillement = "Ensoleillement " & vbTab & vbTab & EnsolJour
        Forme.Lbl_Ensoleillement = "Ensoleillement" & vbTab & vbTab & Format(EnsolJour, "hh:mm")
        With Worksheets("MaPosition")
            If .cells(2, 2) = "" Then Forme.Lbl_Ensoleillement = "Lever du soleil"
        End With

        Forme.dif_ensoleil = "(" & IIf(EnsolPréc > EnsolJour, "-", "+") & Format(Minute(EnsolPréc - EnsolJour), "0") & " min)"
        With Worksheets("MaPosition")
            If .cells(2, 2) = "" Then Forme.dif_ensoleil = ""
        End With
       
        HZenith = Format(ZenithTime(vdate, 3.36667), "hh:mm:ss")
        'Forme.Lbl_Zenith = "Zenith " & vbTab & vbTab & vbTab & HZenith
        Forme.Lbl_Zenith = "Zenith" & vbTab & vbTab & vbTab & Format(HZenith, "hh:mm")
        With Worksheets("MaPosition")
            If .cells(2, 2) = "" Then Forme.Lbl_Zenith = "Zenith"
        End With
        Forme.requête
        Tic
        Call JoursRestantsAvantProchaineSaison
    End With
    'Forme.Show
End Sub

 

[jcf6464]

Bonsoir à vous tous,

Chez moi cela fonctionne pas d'erreurs
Par contre j'ai supprimer le Tic

bonne continuation jcf

 

[dysorthographie]

ton dernier fichier modifié

 

[jurassic pork]

Hello,

Que dit le message d'erreur. Si cela pose problème j'enlève le timer je trouvais ça rigolo d'avoir un suivi de la marrée journalière à la minute.

Après investigation, c'est bien le Timer qui faisait planter Excel. Et pourquoi ?
Parce qu'avec ton intervalle de Timer de 500 ms , la procédure appelée arrivait en plein pendant une période de remplissage du formulaire et avec un timer windows avec l'emploi d'un adressof si la procédure est exécutée au mauvais moment, ça fait planter Excel. L'utilisation d'un Application.Ontime est plus sûre puisque c'est Excel qui contrôle l'exécution de la procédure. Le seul problème c'est que l'on ne peut pas faire un intervalle en dessous de la seconde. Mais je n'ai pas compris pourquoi tu avais mis un intervalle de 500 ms alors que tu parles d'un intervalle à la minute. Et il fallait pas oublier d'arrêter le Timer lorsqu'on fermait le formulaire.
Voici un exemple d'utilisation d'Application.Ontime ( 1 appel au bout de 10s puis appel toutes les 5 secondes)

Public EarliestTime

Sub Test_TimerOnTime()
EarliestTime = Now + TimeValue("00:00:10")
Application.OnTime EarliestTime, "TimerProc"
End Sub

Sub TimerProc()
    Debug.Print "TimerProc"
    EarliestTime = Now + TimeValue("00:00:05")
    Application.OnTime EarliestTime, "TimerProc"
    DoEvents
End Sub

Sub StopOnTime()
    On Error Resume Next
    Application.OnTime EarliestTime, "TimerProc", Schedule:=False
    DoEvents
End Sub

Ami calmant, J.P

 

[dysorthographie]

Bonjour,
Bonjour jurassic pork, personnellement je n'aime pas ce type de timer car il propose in intervalle irrégulier.

Mon timer ce trouve dans un module de classe et s'arrête automatiquement quand son instance est libérée à Nothing dans mon code quand on quitte le formulaire ou a la sortie de la portée {quand on quitte le formulaire}.

Le problème était sur la convention des champ matin_basse_mere etc en Time avant l'initialisation de ces derniers. Le timer étant activé le plantage était inévitable

Le processus que tu proposes aurait produit exactement les mêmes effets demans les mêmes conditions.

C'était rigolo mais pas indispensable et je l'ai retiré.

Merci à toi.

 

[jurassic pork]

Bonjour jurassic pork, personnellement je n'aime pas ce type de timer car il propose in intervalle irrégulier.

En fait sous windows 11 la précision est de 15 ms .

 

[dysorthographie]

Ceci dit in intervalle de 500 millisecondes j'étais vraiment pessimiste.

 

[vgendron]

Hello
juste en passant..
pourquoi remettre systématiquement le formulaire en modal?? pour un besoin spécifique qui est apparu au cours du fil??
le timer de 500ms.. c'est pour mettre à jour le coté montant ou descendant de la marée ??
500ms.. pour un phénomène qui dure 6h.... c'est un peu comme regarder sa montre toutes les 2s en attendant le rendez vous qu'on a demain...

 

[dysorthographie]

Hello
juste en passant..
pourquoi remettre systématiquement le formulaire en modal?? pour un besoin spécifique qui est apparu au cours du fil??
le timer de 500ms.. c'est pour mettre à jour le coté montant ou descendant de la marée ??
500ms.. pour un phénomène qui dure 6h.... c'est un peu comme regarder sa montre toutes les 2s en attendant le rendez vous qu'on a demain...

Et que penses tu du travail que Patrick et moi avions propose,a l'époque sur dvp.com, concernant l'éphéméride et la lunaison. Ainsi que la totalité du code sur les marrées ?

Je suis intervenu parce que Nicolas m'a sollicité. Bien évidemment j'accepte les remarques constructives.

Pour le timer si je l'avais mis à 1 millisecondes c'est pas ça qui aurait planté l'application.

 

[vgendron]

dvp.com...connais pas...
et je vois pas à quel moment j'ai remis en cause ton travail...
je repose juste une question à laquelle je n'ai pas eu de réponse.. Pourquoi formulaire en Modal
si l'utilisateur veut changer de date, il doit fermer le formulaire avant de cliquer sur une autre date:
dans les premières versions, c'était pas le cas.. du moins sur le post "Lunaison, soleil...GPS... et tous les autres post que Nicolas a créé pour ce fichier