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
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 Sheets("Lune").ListObjects("t_Lune")
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
'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 152
'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
''''''''''''''''''''''''''''''''''''''''''''''''''''
End With
'.Lbl_Jour.Caption = IIf(vdate = Date, WorksheetFunction.Proper(Format(vdate, "dddd")) & " " & Format(vdate, "dd mmmm yyyy") & " " & _
'"(aujourd'hui)", WorksheetFunction.Proper(Format(vdate, "dddd")) & " " & Format(vdate, "dd mmmm yyyy"))
.Lbl_Jour.Caption = WorksheetFunction.Proper(Format(vdate, "dddd")) & " " & Format(vdate, "dd mmmm yyyy")
.Lbl_NumSem.Caption = "Semaine n° " & DatePart("ww", vdate, vbMonday, vbFirstFourDays)
.Dates = vdate ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.VILLES = "Hennebont"
.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."
.Lbl_NvlLune.Caption = Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(1, 2)
.Lbl_PreQu.Caption = Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(2, 2)
.Lbl_PleineLune.Caption = Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(3, 2)
.Lbl_DernierQuartier.Caption = Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(4, 2)
.Lbl_NvlLune2.Caption = Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(5, 2)
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")
'Forme.Lbl_CoucherSoleil = "Coucher du soleil" & vbTab & CoucherTU
Forme.Lbl_CoucherSoleil = "Coucher du soleil" & vbTab & Format(CoucherTU, "hh:mm")
'Forme.Lbl_Ensoleillement = "Ensoleillement " & vbTab & vbTab & EnsolJour
Forme.Lbl_Ensoleillement = "Ensoleillement" & vbTab & Format(EnsolJour, "hh:mm")
Forme.dif_ensoleil = "(" & IIf(EnsolPréc > EnsolJour, "-", "+") & Format(Minute(EnsolPréc - EnsolJour), "0") & " min)"
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")
Forme.requête
Call JoursRestantsAvantProchaineSaison
End With
End Sub