1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
| Dim Dd As Date, Df As Date
Dim Sd As Byte, Sf As Byte, i As Byte
Dim LastLig As Long, j As Long
With Sheets("Feuil1") 'à adapter
LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row 'dernière cellule remplie de la colonne C
With .Range("H2:BH" & LastLig) 'On efface la plage du planning
.ClearContents
.Interior.ColorIndex = xlNone
End With
For j = 2 To LastLig
Dd = CDate(.Range("D" & j).Value) 'date de début en colonne D
Df = CDate(.Range("F" & j).Value) 'date fin en colonne F
Sd = DatePart("ww", Dd, vbMonday, vbFirstFourDays) 'N° semaine de de début
Sf = DatePart("ww", Df, vbMonday, vbFirstFourDays) 'N° semaine fin
.Range("E" & j).Value = Sd 'on écrit en E le n° semaine de de début
.Range("G" & j).Value = Sf 'on écrit en G le n° semaine de de fin
For i = Sd To Sf 'On boucle et en remplit (semaine 1 en colonne 8:H
.Cells(j, 7 + i).Value = Left(.Range("C" & j).Value, 1)
.Cells(j, 7 + i).Interior.Color = RGB(10 * j, Abs(256 - 20 * j), 20 * j)
'Tu peux colorier le service en colonne C, cette couleur sera reportée dans le planning
'.Cells(j, 7 + i).Interior.Color = .Range("C" & j).Interior.Color
Next i
Next j
End With |
Partager