Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim nomSh As String, parmiFeuilles As String
Dim xsh As Shape, nbj&, i&, j&, t, s$
nomSh = "," & LCase(Sh.Name) & ","
parmiFeuilles = "," & LCase(NomDesFeuilles) & ","
If InStr(parmiFeuilles, nomSh) = 0 Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each xsh In Sh.Shapes
If xsh.Name Like "gel_*" Then xsh.Delete
Next xsh
On Error GoTo 0
nbj = Day(DateSerial(Year([b6]), Month([b6]) + 1, 0))
For i = 7 To Rows.Count
t = Cells(i, 1).Resize(1, nbj + 1)
If Trim(t(1, 1)) = "" Then Exit For
If Trim(t(1, 1)) <> "M." And Trim(t(1, 1)) <> "Mme" Then
s = ""
For j = 2 To UBound(t, 2): s = s & Trim(t(1, j)): Next
If InStr(s, "D") = 0 Then
Set xsh = Sh.Shapes.AddShape(msoShapeRoundedRectangle, 288.6, 22.8, 182.4, 40.8)
With xsh
.Name = "gel_" & i
.TextFrame2.TextRange.Characters.Text = "fournir gel douche et shampoing"
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(192, 0, 0)
.Fill.ForeColor.RGB = RGB(255, 242, 204)
.Left = Cells(i, "m").Left + 1
.Top = Cells(i, "m").Top + 1
.Height = Cells(i, "m").Height - 2
.Width = 10 * Cells(i, "m").Width
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.TextFrame2.TextRange.Font.Size = 10
.Line.Visible = msoFalse
End With
End If
End If
Next i
End Sub