Salut gvoisin,
ton fichier avec quelques améliorations :
- ton nouveau blocage comme demandé ;
- j'ai remis la multi-copie avec ciblage dans l'agenda ;
- le code ST s'inscrit automatiquement en sélectionnant la cellule OU s'efface si déjà affiché (en cas d'erreur) ;
- la multi-copie s'applique aussi pour une correction et donc, peut effacer la sélection ;
- à l'ouverture du fichier, l'agenda se cale sur le lundi de la semaine en cours
- un clic-droit sur [F6] colore cette cellule de rouge ou noir.
* ROUGE = la macro ne t'avertit pas qu'il y a doublon entre ST. Je suppose qu'à un moment, en connaissant le fonctionnement des macros, tu comprendras ce qu'il se passe sans avoir non-stop ces avertissements !
* NOIR = MsgBox d'avertissement à chaque doublon ST
Le fichier ne voulant pas se charger, voici les codes.
EDIT "Petit" détail : tout fichier contenant des macros doit être enregistré au format XLSM !!
À coller dans 'ThisWorkbook'
Private Sub Workbook_Open()
'
Worksheets("Planning").Activate
If Year(CDate(Range("I6").Value)) = Year(Date) Then _
ActiveWindow.ScrollColumn = 8 + (DateDiff("d", DateSerial(Year(Date) - 1, 12, 31), Date) - (Weekday(Date, vbMonday) - 1))
'
End Sub
Á coller dans 'Planning' en lieu et place des précédents
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'
If Not Intersect(Target, Range("F6")) Is Nothing Then _
Cancel = True: _
Target.Font.Color = IIf(Target.Font.Color = RGB(255, 0, 0), RGB(0, 0, 0), RGB(255, 0, 0))
'
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'
If Target.Column > 8 And Target.Row > 6 And Target <> "" Then _
If WorksheetFunction.CountIf(Range(fctCol(Target.Column) & 6).Resize(Range(fctCol(Target.Column) & Rows.Count).End(xlUp).Row), Target) > 1 Then _
Target = "": _
If Range("F6").Font.Color = RGB(0, 0, 0) Then _
MsgBox "Cette équipe est déjà employée sur un autre chantier !", vbInformation + vbOKOnly, "FP IDF - Info"
'
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim iRow%, iCol%
'
iRow = Selection.Row
iCol = Selection.Column
If Selection.Cells(1, 1).Row > 6 And Selection.Cells(1, 1).Column > 8 Then
If Selection.Count = 1 Then
If Range("E" & iRow).Value <> "" Then Target = IIf(Target = "", Range("F" & iRow).Value, "")
Else
For x = iCol To iCol + Selection.Columns.Count - 1
If Weekday(Range(fctCol(x) & 6), vbMonday) < 6 Then Range(fctCol(x) & iRow) = Selection.Cells(1, 1)
Next
End If
End If
'
End Sub
Public Function fctCol(ByVal iCol%) As String
'
fctCol = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
'
End Function
A+