Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)

[un internaute]

Bonjour le forum
Je voudrais mettre en couleur la ligne contenant "Repos "Congés" par VBA car les 3 MFC occupées
Colonnes B à E

La colonne A est bonne

Macro ci-dessous

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date
Dim MoisSuivant As String
Dim sDate As String, ValDate As Variant
Dim MoisPrec As String

    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Sh.Range("B6:B36")) Is Nothing Then
        If Target.Value = "" Then
            Cells(Target.Row, "A").Resize(, 3) = ""
            Cells(Target.Row, "I") = ""
        ElseIf IsNumeric(Target) Then       ' Ajout ligne Modifs le 09/02/2023 pour pouvoir taper un nombre même s'il y a Repos ou Congés dans la cellule colonne B
            Cells(Target.Row, "C") = ""     ' Ajout ligne Modifs le 09/02/2023 pour pouvoir taper un nombre même s'il y a Repos ou Congés dans la cellule colonne B
        End If
    End If
 
  If Not Intersect(Target, Sh.Range("F2:F3")) Is Nothing Then          '1ère ligne en commentaires pour employer le /
    ValDate = Target.Value2
    If IsNumeric(ValDate) Then
      ' Selon la saisie effectuée
      Select Case Len(ValDate)
      Case 4  ' format jmaa
        sDate = "0" & Left(ValDate, 1) & "/0" & Mid(ValDate, 2, 1) & "/" & Right(ValDate, 2)
      Case 5  ' format jmmaa
        sDate = "0" & Left(ValDate, 1) & "/" & Mid(ValDate, 2, 2) & "/" & Right(ValDate, 2)
      Case 6  ' format jjmmaa
        sDate = Left(ValDate, 2) & "/" & Mid(ValDate, 3, 2) & "/" & Right(ValDate, 2)
      Case 7  ' format jmmaaaa
        sDate = Left(ValDate, 1) & "/" & Mid(ValDate, 2, 2) & "/" & Right(ValDate, 4)
      Case 8  ' format jjmmaaa
        sDate = Left(ValDate, 2) & "/" & Mid(ValDate, 3, 2) & "/" & Right(ValDate, 4)
      End Select
      End If
      
      Dim J As Integer
      Dim Total As Double
      
      Application.EnableEvents = False
      On Error Resume Next
      Target.Value = CDate(sDate)
      On Error GoTo 0
      Target.NumberFormat = "dd mmm yyyy"
      Application.EnableEvents = True
      
      If Month(DateValue(Sh.Name)) > 1 Then
        MoisPrec = Application.Proper(Format(DateAdd("m", -1, DateValue(Sh.Name)), "Mmmm yyyy"))
        If Target <= CDate(Range("'" & MoisPrec & "'!F3")) Then
          MsgBox "Attention " & vbCr & vbCr & "La date inscrite est plus petite que la dernière date de la feuille " & MoisPrec
          Application.EnableEvents = False
          Target = ""
          Application.EnableEvents = True
          Exit Sub
        Else
          For J = 36 To 6 Step -1          '******* Nouvelle partie de macro Début
          If Range("'" & MoisPrec & "'!I" & J) <> "" Then
          If CDate(Range("F2")) <= CDate(Range("'" & MoisPrec & "'!I" & J)) Then Total = Total + _
            Val(Range("'" & MoisPrec & "'!D" & J)) + _
            Val(Range("'" & MoisPrec & "'!E" & J))

          End If
          Next J
           Range("F6") = TotalFrais([F2], [F3])
          End If
          End If                           '******* Nouvelle partie de macro Fin
  Else                                     '1ère ligne en commentaires pour employer le /
    Application.EnableEvents = False
    ' On recherche si la page est surveillée
    If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
                Split(Sh.Name, " ")(0), vbTextCompare) Then
      ' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
      NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
      
      If Target.Row - 5 > Day(Date) Then
        Beep
        MsgBox "PAS LE BON JOUR"
        Target = ""
      Else
 
        ' Surveille la plage du 1er au dernier jours du mois
        'If Not Intersect(Range("B6:C" & 5 + NombreJour, "F6:F" & 5 + NombreJour), Target) Is Nothing Then
        If Not Intersect(Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then
          ' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
          Ladate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
          ' Si la colonne B et la colonne C est vide on efface la date
          Select Case Range("B" & Target.Row)
            Case "Repos", "Congés"
              Range("C" & Target.Row) = Range("B" & Target.Row)
          End Select
          If Range("B" & Target.Row) = "Congés" Or Range("B" & Target.Row) = "Repos" Then Range("C" & Target.Row) = Range("B" & Target.Row)
          Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Application.Proper(Format(Ladate, "dddd dd mmmm yyyy")))
          Range("I" & Target.Row) = IIf(Range("A" & Target.Row) & Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)
          Range("H" & Target.Row) = IIf(Not (IsNumeric(Range("B" & Target.Row))), 0, 1)
          If Range("B" & Target.Row) = "" Then
            Range("H" & Target.Row) = ""
          ElseIf Weekday(CDate(Range("I" & Target.Row)), 2) >= 6 Then   'Modifs le 12/02//2023 pour ne pas afficher 1 dans colonne H. Avant modifs = 6 Then
            Range("H" & Target.Row) = 0
          End If
          ' si la ligne modifiée est la dernière du mois et que la colonne est la C
          If Target.Row = NombreJour + 5 And Target.Column = 3 Then       ' Colonne C
            ' On construit le nom de la feuille du mois suivant
            MoisSuivant = MonthName(Month(DateAdd("m", 1, DateValue(Sh.Name)))) & " " & Year(DateAdd("m", 1, DateValue(Sh.Name)))
            ' On va vérifier si la feuille existe
            If FeuilleExiste(MoisSuivant) = False Then   'Exit Function
            ' La feuille existe
            With Sheets(MoisSuivant)
              'On la rend visible
              .Visible = xlSheetVisible
              ' On masque celle que l'on vient de finir
              ActiveSheet.Visible = xlSheetHidden
              ' et on la sélectionne
              .Select
            End With
          End If
        End If
      End If
    End If
  End If                                           'Mettre en commentaires pour employer le /
  End If
 
  Application.EnableEvents = True
'End Function
End Sub

Merci à vous pour vos éventuels retours

 

[un internaute]

[RÉSOLU]