Function recup_phase_lune(année, mois)
Dim i As Long, col As Long, lig As Long, nbjour As Long
Dim dernierIndice As Integer
Dim texte
Application.ScreenUpdating = False
nbjour = day(DateSerial(année, mois + 1, 0)) ' te donne le nombre de jours dans le mois en parametre
col = Weekday(DateSerial(année, mois, 1), vbMonday) + 1 ' te donne l'index du jour de la semaine (commencant un lundi), et ajouter 1 si calendrier commence en colonne "A"
lig = 3
With Worksheets("Calendrier")
For i = 1 To nbjour
If col = 9 Then lig = lig + 2: col = 2 'pour changer de ligne quand on arrive au dimanche
If Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(1, 2) = DateSerial(année, mois, i) Then 'si on est sur la date du jour
.Cells(lig, col).AddComment
.Cells(lig, col).Comment.Text Text:="Nouvelle lune" & vbCrLf & "à " & vbCrLf & Hour(Worksheets("Lune").ListObjects("t_Lune") _
.DataBodyRange(1, 3)) & " h " & Minute(Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(1, 3)) & " min "
.Cells(lig, col) = .Cells(lig, col) & " " & Chr(152)
dernierIndice = Len(.Cells(lig, col))
.Cells(lig, col).Characters(dernierIndice - 1, 2).Font.Name = "Wingdings 2"
ElseIf Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(2, 2) = DateSerial(année, mois, i) Then
.Cells(lig, col).AddComment
.Cells(lig, col).Comment.Text Text:="Premier quartier de lune" & vbCrLf & "à " & vbCrLf & Hour(Worksheets("Lune") _
.ListObjects("t_Lune").DataBodyRange(2, 3)) & " h " & Minute(Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(2, 3)) & " min "
.Cells(lig, col) = .Cells(lig, col) & " " & Chr(130)
dernierIndice = Len(.Cells(lig, col))
.Cells(lig, col).Characters(dernierIndice - 1, 2).Font.Name = "Wingdings 2"
ElseIf Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(3, 2) = DateSerial(année, mois, i) Then
.Cells(lig, col).AddComment
.Cells(lig, col).Comment.Text Text:="Pleine lune" & vbCrLf & "à " & vbCrLf & Hour(Worksheets("Lune").ListObjects("t_Lune"). _
DataBodyRange(3, 3)) & " h " & Minute(Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(3, 3)) & " min "
.Cells(lig, col) = .Cells(lig, col) & " " & Chr(153)
dernierIndice = Len(.Cells(lig, col))
.Cells(lig, col).Characters(dernierIndice - 1, 2).Font.Name = "Wingdings 2"
ElseIf Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(4, 2) = DateSerial(année, mois, i) Then
.Cells(lig, col).AddComment
.Cells(lig, col).Comment.Text Text:="Dernier quartier de lune" & vbCrLf & "à " & vbCrLf & Hour(Worksheets("Lune"). _
ListObjects("t_Lune").DataBodyRange(4, 3)) & " h " & Minute(Worksheets("Lune").ListObjects("t_Lune").DataBodyRange(4, 3)) & " min "
.Cells(lig, col) = .Cells(lig, col) & " " & Chr(131)
dernierIndice = Len(.Cells(lig, col))
.Cells(lig, col).Characters(dernierIndice - 1, 2).Font.Name = "Wingdings 2"
End If
col = col + 1 'on se déplace sur le jour suivant
Next i
End With
Application.ScreenUpdating = True
End Function