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 26 27 28 29
| Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Range("A3:G10")
Application.ScreenUpdating = False
debPlan = DateSerial(2020, 1, 1)
Set fActivités = Sheets("Activités")
Set fCalendrier = Sheets("Calendrier")
[D6:JUC32].ClearContents
[D6:JUC32].Interior.ColorIndex = xlNone
nbactivités = fActivités.[B1].CurrentRegion.Rows.Count
For i = 3 To nbactivités
Responsable = fActivités.Cells(i, 4)
Set Result = fCalendrier.[C:C].Find(What:=Responsable, LookIn:=xlValues)
If Not Result Is Nothing Then
If fActivités.Cells(i, 3) < DateSerial(2040, 1, 1) Then
ddébut = fActivités.Cells(i, 5)
dfin = fActivités.Cells(i, 7)
Libellé = fActivités.Cells(i, 2)
fCalendrier.Cells(Result.Row, ddébut) = Libellé
lig = Result.Row
For d = ddébut To dfin
fCalendrier.Cells(Result.Row, d).Interior.ColorIndex = 6
Next d
End If
End If
Next i
End Sub |
Partager