Interior color ligne SANS MFC

Bonjour le forum

Bonjour Theze

La macro ci-dessous fonctionne très bien pour l'année 2019

Lorsque je recommence une nouvelle année par exemple 2020 ça bug sur la ligne ci-dessous lorsque je tape un nombre de départ par exemple 10 000 et ça ne marque rien sur toute la ligne du jour

Fichier joint

Lorsqu'on tape 10000 par exemple cellule B4 pour démarrer l'année ça bug

Lorsqu'on tape 4 par exemple cellule B6 ça n'affiche rien sur la ligne

Fichier joint

Excel 2003

Merci pour vos éventuels retours

F = Plage.Columns(1).NumberFormat

Voici la macro

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)    'Macro sans COLORISE

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

Bonjour,

Je n'ai pas cette erreur donc, testes en remplaçant cette ligne :

F = Plage.Columns(1).NumberFormat

par celle-là :

If IsNull(Plage.Columns(1).NumberFormat) Then F = "dddd dd mmmm yyyy" Else F = Plage.Columns(1).NumberFormat

Bonjour Theze

Nickel

J'ai mis aussi pour 2019

On verra demain matin pour mettre résolu mais ça a l'air de fonctionner aussi

Encore un grand merci à toi

Bon dimanche

Cordialement

Bonjour Theze et bonjour le forum

Ça tourne nickel

Merci encore (je ne fait que ça)!!!

Je te souhaite une bonne semaine

Bonjour,

Content de t'aider et bonne semaine à toi aussi