[degap05]

Voila le code de mon fichier de travail, je suppose qu'il ne doit pas être trés "propre".
Oui la coloration en gris de toute la ligne se fait en colonne 20.


Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Lig, derlig, num1 As Integer, Couleur As Long
Lig = Target.Row
If Target.Count > 1 Then Exit Sub
'déprotège toute les feuilles
ActiveSheet.Unprotect
Sheets("Ordonnancier").Unprotect
Sheets("Patients").Unprotect
Sheets("Dotation").Unprotect
Sheets("Nominatif").Unprotect
If Target.Value = "" Then GoTo suite
If Target.Column = 26 Then
With Sheets("Ordonnancier")
.Visible = True
derlig = .Range("A65500").End(xlUp).Row + 1
.Cells(derlig, 2).Value = Cells(Lig, 2).Value
' tenir compte des 2 colonnes cachées
.Cells(derlig, 3).Value = Cells(Lig, 3).Value
.Cells(derlig, 4).Value = Cells(Lig, 10).Value
.Cells(derlig, 5).Value = Cells(Lig, 9).Value
.Cells(derlig, 6).Value = Cells(Lig, 12).Value
.Cells(derlig, 7).Value = Cells(Lig, 11).Value
.Cells(derlig, 8).Value = Cells(Lig, 20).Value
.Cells(derlig, 9).Value = Cells(Lig, 26).Value
.Cells(derlig, 10).Value = Cells(Lig, 8).Value
.Cells(derlig, 11).Value = Cells(Lig, 21).Value
.Cells(derlig, 12).Value = Cells(Lig, 22).Value
.Cells(derlig, 13).Value = Cells(Lig, 23).Value
.Cells(derlig, 14).Value = Cells(Lig, 24).Value
.Cells(derlig, 15).Value = Cells(Lig, 25).Value
.Cells(derlig, 1).Value = ActiveSheet.Name
num1 = .Cells(derlig - 1, 16).Value
.Cells(derlig, 16).Value = num1 + 1
End With
derlig = [A4].End(xlDown).Row
Range("A" & Target.Row & ":Z" & Target.Row).SpecialCells(xlCellTypeConstants).Clea rContents
Range("A4", Cells(derlig, Target.Column)).Sort Key1:=Range("B4"), Order1:=xlAscending, Key2:=Range( _
"C4"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
End If

' pour protéger la ligne qui vient d'être validée et enregistrée à l'ordonnancier
'Target.EntireRow.Select
'Selection.Locked = True
'Lig = Target.Row
'Cells(Lig + 0, 1).EntireRow.Select
'Selection.Locked = True
'pour remplir les données de l'imprimé Nominatif
'End If
If Target.Column = 18 Then
With Sheets("Nominatif")
derlig = .Range("A65500").End(xlUp).Row + 1
.Range("F11").Value = Cells(Lig, 9).Value
.Range("B9").Value = Range("H1").Value
.Range("D1").Value = Cells(Lig, 8).Value
.Range("B3").Value = Cells(Lig, 18).Value
.Range("B4").Value = Cells(Lig, 14).Value
.Range("B5").Value = Cells(Lig, 15).Value
.Range("B6").Value = Cells(Lig, 16).Value
.Range("B7").Value = Cells(Lig, 17).Value
.Range("B10").Value = Cells(Lig, 2).Value
.Range("B11").Value = Cells(Lig, 3).Value
.Range("F9").Value = Cells(Lig, 10).Value
.Range("E45").Value = Cells(Lig, 12).Value
.Range("E46").Value = Cells(Lig, 11).Value
num1 = .Range("F2").Value
.Range("F2") = num1 + 1
End With
'pour remplir les données de l'imprimé Dotation
End If
If Target.Column = 8 Then
With Sheets("Dotation")
derlig = .Range("A65500").End(xlUp).Row + 1
.Range("F11").Value = Cells(Lig, 6).Value
.Range("B9").Value = Range("H1").Value
.Range("D1").Value = Cells(Lig, 8).Value
.Range("B10").Value = Cells(Lig, 2).Value
.Range("B11").Value = Cells(Lig, 3).Value
.Range("F9").Value = Cells(Lig, 7).Value
num1 = .Range("F2").Value
.Range("F2") = num1 + 1
End With
'pour colorer les cellules à la dispensation
suite:
End If
If Target.Column = 8 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 8)).Interior.ColorIndex = 43
Else
Range(Cells(Lig, 1), Cells(Lig, 8)).Interior.ColorIndex = xlNone
End If
End If
If Target.Column = 18 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 18)).Interior.ColorIndex = 44
Else
Range(Cells(Lig, 1), Cells(Lig, 18)).Interior.ColorIndex = xlNone
End If
End If
If Target.Column = 20 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 25)).Interior.ColorIndex = 48
Else
Range(Cells(Lig, 1), Cells(Lig, 25)).Interior.ColorIndex = xlNone
End If
End If
'protège toutes les feuilles
Application.EnableEvents = True
Application.ScreenUpdating = True
'Sheets("Ordonnancier").Protect
'Sheets("Patients").Protect
'Sheets("Dotation").Protect
'Sheets("Nominatif").Protect
'ActiveSheet.Protect
End Sub