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 Sub

Tu 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

7toto.zip (54.17 Ko)

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 = 8

Merci à vous et bonne fin de soirée

Fichier joint

8toto.zip (56.54 Ko)

Bonjour le forum

J'attends demain matin pour mettre résolu

Bon WE

Rechercher des sujets similaires à "effacer ligne couleur efface donnees colonne"