Effacer ligne en couleur si on efface Données dans colonne B ou C
Bonjour le forum et bonjour Theze
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'La Macro COLORISE ne sert plus (mise en commentaires)
Dim NombreJour As Integer
Dim Ladate As Date
Dim MoisSuivant As String
Dim Plage As Range
Dim Cel As Range
Dim F As String
Dim I As Integer
Dim J As Integer
If Target.Count > 1 Then Exit Sub
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 = ""
Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).Interior.ColorIndex = 8
Else
' Surveille la plage du 1er au dernier jours du mois
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
Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)
' 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
' 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 Sub
' 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
If Range("A" & Target.Row) <> "" Then
Application.ScreenUpdating = False
Set Plage = Range(Cells(6, 1), Cells(6 + NombreJour, 1)).Resize(, 7)
'mémorise le formatage de la colonne A puis passe la colonne A au format "Standard" pour avoir des valeurs de type Long
'F = Plage.Columns(1).NumberFormat 'Si cette ligne de macro ne fonctionne pas appliquer la ligne ci-dessous
If IsNull(Plage.Columns(1).NumberFormat) Then F = "dddd dd mmmm yyyy" Else F = Plage.Columns(1).NumberFormat
Plage.Columns(1).NumberFormat = "General"
'effectue la recherche de la date en type Long sur la colonne A
Set Cel = Plage.Columns(1).Find(CLng(Date), , xlValues, xlWhole)
'puis rétabli le format
Plage.Columns(1).NumberFormat = F
Plage.Interior.ColorIndex = 8
'si trouvée, mets la plage au fond 8 puis colore la ligne du jour
If Not Cel Is Nothing Then
Range(Cells(Cel.Row, 1), Cells(Cel.Row, Plage.Columns.Count)).Interior.ColorIndex = 17
J = Cel.Row - 1
End If
If J = 0 Then J = Plage.Rows.Count + 6
'colore ensuite les cellules en fonction du jour
For I = 6 To J
If Cells(I, 1).Value <> "" Then
If Application.CountIf(Sheets("Menu").Range("JOursFériés"), Range("A" & I)) > 0 Or Weekday(Range("A" & I), vbMonday) > 5 Then
Range("A" & I & ":G" & I).Interior.ColorIndex = 38
Else
Range("A" & I).Interior.ColorIndex = 15
Range("B" & I).Interior.ColorIndex = 6
Range("C" & I).Interior.ColorIndex = 4
Range("D" & I & ":G" & I).Interior.ColorIndex = 43
End If
End If
Next I
Application.ScreenUpdating = True
End If
End If
End If
Application.EnableEvents = True
End SubTu m'avais fait ça SANS MFC et ça fonctionne super
Je voudrais si c'est possible lorsque j'efface le nombre ou du texte dans colonne B ou C que ça efface aussi la couleur interior color 17 et que ça remette la couleur interior color de fond 8
Si c'est possible sinon ne t'acharne pas.
Merci à toi
Cordialement
Bonjour le forum
Je vois qu'il y a des vacanciers!!!
Aucun as du vba ne veut s'y coller?
Bonne journée à vous
Cordialement
Bonjour
Je veux bien essayer mais à condition d'avoir ton fichier comme support.
Bye !
Bonjour gmb
Voici le fichier
EXCEL 2003
La macro est dans ThisWorkbook (celle dans le 1er post)
Lorsqu'on efface 3 pour aujourd'hui je voudrais si c'est possible que le fond redeviennent en bleu (interior color index 8)
Lorsque tu re-ouvre le fichier 3 s'affiche à nouveau c'est normal
Merci à toi
Cordialement
Bonjour le forum
Personne pour s'y coller?
Cordialement
Bonsoir le forum
Fait par un internaute sur un autre forum
Je fait partager la solution
Ajout de cette ligne dans macro
If Range("A" & Target.Row) = "" Then Cells(Target.Row, 1).Resize(, 7).Interior.ColorIndex = 8Merci à vous et bonne fin de soirée
Fichier joint
Bonjour le forum
J'attends demain matin pour mettre résolu
Bon WE