un internaute
XLDnaute Impliqué
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
Merci à vous pour vos éventuels retours
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
VB:
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 SubMerci à vous pour vos éventuels retours
