Sub Test()
Dim I As Integer, MaDate As Date, MaDate2 As Date
Dim MaDate3 As Date, Durée As Integer, MaPlage As Range
For I = 4 To 13 ' Les lignes de Delivery à File
MaDate = Cells(I, 5) ' date arrivée
MaDate2 = Cells(I + 1, 5) + 1 ' date départ
Durée = MaDate - MaDate2
MaDate3 = WorksheetFunction.EoMonth(MaDate2, 0) ' fin du mois de la date de départ
If MaDate3 < MaDate Then ' si la fin du mois se situe entre les dates
Set MaPlage = Range(Cells(Month(MaDate2) * 4 - 11, Day(MaDate2) + 8), _
Cells(Month(MaDate3) * 4 - 11, Day(MaDate3) + 8))
' la première plage s'étend de la ligne N° de mois x 4 (écart entre les mois)
' correctif -11 (vu qu'avril commence en ligne 3), colonne N° du jour
' correctif 8 (vu que le 1er du mois est en I) au même raisonnement
' pour le dernier jour du mois
Call Présentation(MaPlage, Cells(I, 6).Interior.Color, Cells(I, 6).Value, _
Cells(I, 6).Font.Color) ' appel de la macro ci-dessous pour ne pas répéter à chaque
' les même lignes, en envoyant la couleur et le texte de la ligne qu'on traite
Set MaPlage = Range(Cells(Month(MaDate3 + 1) * 4 - 11, Day(MaDate3 + 1) + 8), _
Cells(Month(MaDate) * 4 - 11, Day(MaDate) + 8))
' idem pour fin de mois + 1 (soit 1er du mois suivant) à date fin
Call Présentation(MaPlage, Cells(I, 6).Interior.Color, Cells(I, 6).Value, _
Cells(I, 6).Font.Color)
Else ' sinon, même raisonnement, mais sans fin de mois
Set MaPlage = Range(Cells(Month(MaDate2) * 4 - 11, Day(MaDate2) + 8), _
Cells(Month(MaDate) * 4 - 11, Day(MaDate) + 8))
Call Présentation(MaPlage, Cells(I, 6).Interior.Color, Cells(I, 6).Value, _
Cells(I, 6).Font.Color)
End If ' fin du test
Next I ' I suivant
Set MaPlage = Cells(Month(Cells(14, 5)) * 4 - 11, Day(Cells(14, 5) + 8))
' traitement de la dernière ligne S
Call Présentation(MaPlage, Cells(14, 6).Interior.Color, Cells(14, 6).Value, _
Cells(I, 14).Font.Color)
End Sub
Sub Présentation(Plage As Range, Couleur As Double, Texte As String, CouleurTexte As Double)
Plage.Interior.Color = Couleur ' fond en couleur
Plage.Font.Bold = True ' police en gras
Plage.Font.Color = CouleurTexte ' couleur de la police
If Plage.Count > 1 Then Plage.Merge ' si j'ai plus d'une case, je fusionne les cellules
Plage.Cells(1, 1).Value = Texte ' j'envoie le texte dans la 1ère cellule, qu'il y ai fusion ou non
End Sub