Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
nstage = 11 ' nombre de stages
For m = 1 To 6 ' nombre de mois
[C4:M35].Offset(, (m - 1) * (nstage + 2)).ClearContents
[C4:M35].Offset(, (m - 1) * (nstage + 2)).Interior.ColorIndex = xlNone
[C4:M35].Offset(, (m - 1) * (nstage + 2)).ClearComments
[C38:M69].Offset(, (m - 1) * (nstage + 2)).ClearContents
[C38:M69].Offset(, (m - 1) * (nstage + 2)).Interior.ColorIndex = xlNone
[C38:M69].Offset(, (m - 1) * (nstage + 2)).ClearComments
Next m
'Stop
Set planning = Sheets("calendrier")
Set bd = Sheets("BD")
For s = 1 To [Stage].Count
If UCase(bd.Range("stage")(s)) <> "" Then
If bd.Range("début")(s) <> "" And Year(bd.Range("début")(s)) = [an] Then
jd = Day(bd.Range("début")(s))
md = Month(bd.Range("début")(s))
For c = 1 To 11
If Cells(IIf(md < 7, 4, 38), (md - IIf(md < 7, 1, 7)) * (nstage + 2) + 3 + c) = "" Then
colLibre = c
Cells(IIf(md < 7, 4, 38), (md - IIf(md < 7, 1, 7)) * (nstage + 2) + 3 + c) = bd.Range("lieu")(s) ' "*"
Exit For
End If
Next c
mf = Month(bd.Range("fin")(s))
If mf <> md Then
For c = 1 To 11
If Cells(IIf(md < 7, 4, 38), (mf - IIf(mf < 7, 1, 7)) * (nstage + 2) + 3 + c) = "" Then
colLibreFin = c
Cells(IIf(md < 7, 4, 38), (mf - IIf(mf < 7, 1, 7)) * (nstage + 2) + 3 + c) = bd.Range("lieu")(s) ' "*"
Exit For
End If
Next c
End If
With Cells(IIf(md < 7, 4, 38) + jd, (md - IIf(md < 7, 1, 7)) * (nstage + 2) + 3 + colLibre)
.AddComment
temp = bd.Range("lieu")(s) & Chr(10) & bd.Range("thème")(s)
.Comment.Text Text:=temp
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = False 'True
End With
For d = bd.Range("début")(s) To bd.Range("fin")(s)
j = Day(d)
m = Month(d)
If Year(d) = [an] Then
If m = md Then
Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibre) = bd.Range("stage")(s)
Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibre).Interior.ColorIndex = 36
Else
Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibreFin) = bd.Range("stage")(s)
Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibreFin).Interior.ColorIndex = 36
End If
End If
Next d
End If
End If
Next s
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Worksheet_Activate
End If
End Sub