Option Explicit
Dim fplage As Range, cel As Range
Dim estouvert As Byte
Dim chemin As String, fichier1 As String, fichier2 As String
Dim fich As Workbook
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
'****************************************************************************************************************
' Consulter la gestion des erreurs en cas d'erreur et renvoyer le message associé (voir en fin de macro)*********
'****************************************************************************************************************
On Error GoTo gestion_erreur
'****************************************************************************************************************
'****************************************************************************************************************
chemin = ThisWorkbook.Path 'chemin du fichier actuel
fichier1 = ThisWorkbook.Name 'nom du fichier actuel
fichier2 = chemin & "\Liste.xlsx" 'chemin du fichier "Liste.xlsx"
'****************************************************************************************************************
' Contrôler si le classeur "Liste" est ouvert *******************************************************************
'****************************************************************************************************************
estouvert = 0 'donner la valeur 0 à cette variable
For Each fich In Workbooks
If fich.Name = "Liste.xlsx" Then estouvert = 1 'passer à 1 si le fichier est ouvert
Next
If estouvert = 0 Then Workbooks.Open (fichier2) 's'il n'est pas ouvert, on l'ouvre et on l'active
Windows("Liste.xlsx").Activate 'on revient sur le premier classeur
Set fplage = Sheets(1).Range("A2:A" & Sheets(1).Range("A1").End(xlDown).Row) 'plage de recherche
'****************************************************************************************************************
'****************************************************************************************************************
If Not Intersect(Target, Range("C11:BB41")) Is Nothing Then 'plage modifiable :cellule C41 à BB41
For Each cel In Intersect(Target, Range("C11:BB41"))
If cel = "" Then
cel.Interior.ColorIndex = xlNone
cel.Font.ColorIndex = xlAutomatic
ElseIf cel <> "" Then
cel.Interior.Color = fplage.Find(Target.Value, , LookIn:=xlValues, lookat:=xlWhole).Interior.Color
cel.Font.Color = fplage.Find(Target.Value, , LookIn:=xlValues, lookat:=xlWhole).Font.Color
End If
Next cel
End If
Application.DisplayAlerts = False 'désactiver les alertes
Workbooks("Liste.xlsx").Save 'on sauvegarde les dernières modifications du classeur "Liste"
Workbooks("Liste.xlsx").Close
Application.DisplayAlerts = True 'réactiver les alertes
'****************************************************************************************************************
' Gestion des erreurs *******************************************************************************************
'****************************************************************************************************************
gestion_erreur:
If Err.Number = 91 Then
MsgBox "Le nom introduit n'existe pas dans la liste " & chr(13) & chr(13) & _
"Allez sur le classeur Liste et ajoutez le nom." & chr(13) & _
"Revenez sur le planning et réintroduisez le nouveau nom." _
, vbExclamation, "Nom absent de la liste"
End If
'****************************************************************************************************************
'****************************************************************************************************************
Application.ScreenUpdating = True
End Sub