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 41 42 43 44 45
| Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Dim CellC As Integer, CellR As Integer, Tr As Integer
Set Rg = Range("F2:F139")
If Not Intersect(Rg, Target) Is Nothing Then
Select Case UCase(Target.Value) 'Considère le mot saisi en majuscule
Case Is = "NR" 'Il n'est plus nécessaire d'écrire toute les possibiltés puisque le mot saisi est considéré en majuscule
Target.Interior.Color = RGB(255, 0, 0)
Case Is = "CP"
Target.Interior.Color = RGB(255, 165, 0)
Case Is = "HOUT"
Target.Interior.Color = RGB(0, 0, 255)
Case Is = "HIN"
Target.Interior.Color = RGB(0, 0, 255)
Case Is = "CC"
Target.Interior.Color = RGB(173, 255, 47)
Case Is = "CR"
Target.Interior.Color = RGB(255, 255, 0)
Case Is = "PS"
Target.Interior.Color = RGB(255, 0, 255)
Case Is = "1"
Target.Interior.Color = RGB(255, 255, 255)
Case Else
Target.Interior.Color = xlAutomatic
End Select
'Def Cellule cible feuille Appel PC
Tr = Target.Row
'Vérifie si le changement impacte un type de chambre
If Not IsNumeric(Cells(Tr, 2)) And Cells(Tr, 2) <> "CA" Then
CellC = 15
CellR = Tr - 87
Else:
CellC = Right(Left(Cells(Tr, 1), 3), 1) * 3 'On utilise le numéro du NP de la colonne A pour définir la colonne cible
If Cells(Tr, 2) = "CA" Then
CellR = 29 'si la cellule de la colonne 2 est CA alors c'est d'office la ligne 29 sur la feuille cible
Else:
CellR = Cells(Tr, 2).Value + 6 'si c'est pas CA, c'est le numéro+6 qui correspond à la ligne sur la feuille cible
End If
End If
Sheets("Appel PCO").Cells(CellR, CellC).Interior.Color = Target.Interior.Color
End If
End Sub |
Partager