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 30 31 32 33 34 35 36 37 38 39 40
| Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 3 And Target.Column <> 5 Then Exit Sub
If Cells(Target.Row, 3) <> "" And Cells(Target.Row, 5) <> "" Then
Forme Target.Row
End If
End Sub
Sub Forme(Ligne)
Dim Forme As MsoShapeType, Couleur, H As Single
Dim G As Single, T As Single, Shp As Shape
H = Cells(Ligne, 7).Height
G = Cells(Ligne, 7).Left
T = Cells(Ligne, 7).Top
On Error Resume Next
ActiveSheet.Shapes("Forme" & Ligne).Delete
On Error GoTo 0
If Cells(Ligne, 5) = "pas urgent" Then
Couleur = Array(0, 176, 80)
ElseIf Cells(Ligne, 5) = "assez urgent" Then
Couleur = Array(255, 192, 0)
ElseIf Cells(Ligne, 5) = "urgent" Then
Couleur = Array(255, 0, 0)
ElseIf Cells(Ligne, 5) = "très urgent" Then
Couleur = Array(255, 255, 255)
End If
Select Case Cells(Ligne, 3).Value
Case "soins"
Forme = msoShapeCross
Case "alimentation"
Forme = msoShapeOval
Case "couchage"
Forme = msoShapeRectangle
End Select
Set Shp = ActiveSheet.Shapes.AddShape(Forme, G, T, H, H)
With Shp
.Fill.ForeColor.RGB = RGB(Couleur(0), Couleur(1), Couleur(2))
.Line.Visible = msoFalse
.Name = "Forme" & Ligne
End With
End Sub |
Partager