Bonjour,
Voici. Je vais vous donnez le tout de manière progressive.
1. feuille Provisio : Supprimez toutes les lignes le code que vous avez actuellement et remplacez-les par celles ci-dessous
Option Explicit
Dim stpevt As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row <= 4 Or stpevt = True Then Exit Sub
If Not Intersect(Target, Range("Q" & Target.Row & ":V" & Target.Row)) Is Nothing Then
If Target.Column = 21 Then
stpevt = True
Cells(Target.Row, Target.Column) = "S" & Format(Cells(Target.Row, Target.Column), "00")
stpevt = False
End If
lig = Target.Row
Call planning
End If
If Not Intersect(Target, Range("W" & Target.Row)) Is Nothing Then
If UCase(Target.Value) = vbNullString Then
lig = Target.Row
Call Ajout_couleur(lig, couleur)
End If
End If
End Sub
2. Dans l'éditeur VBA, Module 1 : Remplacez la macro Sub Mise_en_forme et ajoutant les deux codes ci-dessous
Sub Mise_en_forme()
Dim dlg As Integer
'Dim couleur As Long
With Feuil1
.Unprotect
dlg = .Range("B" & Rows.Count).End(xlUp).Row
With .Range("A4:W" & dlg)
'Police
With .Font
.Name = "Calibri"
.Size = 9
End With
'centrer
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
'Bordures autour
.BorderAround LineStyle:=xlContinuous
.BorderAround Weight:=xlThin
End With
'bordures verticales et horizontales
With Union(.Range("A4:A" & dlg), Range("I4:W" & dlg))
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
.Range("P4:P" & dlg).WrapText = True
'mise en couleur selon num semaine
Call Ajout_couleur(dlg, couleur)
.Protect
End With
lig = 0
couleur = 0
End Sub
Sub Ajout_couleur(dlg As Integer, couleur As Long)
'mise en couleur selon num semaine
Select Case Right(Feuil1.Range("B" & dlg), 1)
Case Is = 0: couleur = RGB(238, 140, 138)
Case Is = 1: couleur = RGB(155, 229, 255)
Case Is = 2: couleur = RGB(229, 182, 181)
Case Is = 3: couleur = RGB(198, 224, 180)
Case Is = 4: couleur = RGB(255, 230, 153)
Case Is = 5: couleur = RGB(155, 194, 230)
Case Is = 6: couleur = RGB(213, 213, 173)
Case Is = 7: couleur = RGB(177, 169, 217)
Case Is = 8: couleur = RGB(223, 198, 49)
Case Is = 9: couleur = RGB(173, 229, 208)
End Select
With Feuil1
.Unprotect
.Range("B" & dlg & ":O" & dlg).Interior.Color = couleur
.Protect
End With
End Sub
Les macros Trier et Function ne changent pas
Vous pouvez faire un test sans utiliser l'USF mais vous devez rajouter cette instruction dans le module 2 juste en-dessous de Option explicit
Public couleur As Long
Pour le test :
- ne cliquez pas sur les boutons de votre feuille. Les codes doivent être adaptés
- manuellement mettez en jaune 2 cellules : B5 et F5 (si vous y avez des données)
- ajoutez un X dans W5
- une fois fait, supprimez le X en W5 pour vois la couleur supprimée au profil de celle prévue par rapport au num de semaine