Pourquoi la ligne de hier reste en interior color 17?

Bonjour le forum

La ligne de hier 02/10/2019 reste en interior color 17 alors qu'elle devrait être avec ses couleurs normales suivant les colonnes c'est à dire 15 6 4 43

Si je tape 3 aujourd’hui elle passe bien interior color 17

Je ne suis pas sous MFC volontairement

Merci à vous

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim NombreJour&, Ladate As Date, MoisSuivant$, Plage As Range, cel As Range, F$, i&, J&
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    ' On recherche si la page est surveillée
    If IsDate("1/" & Sh.Name) Then    'plus simple non ???
        ' 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) = "", "", Application.Proper(Format(Ladate, "dddd dd mmmm yyyy")))
        Range("H" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)

                If Range("A" & Target.Row) = "" Then Cells(Target.Row, 1).Resize(, 7).Interior.ColorIndex = 8
                ' 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   'NombreJour
                Set Plage = Range(Cells(6, 1), Cells(5 + NombreJour, 1)).Resize(, 7)  'Mettre 5 dans ligne macro => Cells(5 + NombreJour, 1)).Resize(, 7) au lieu de 6 pour ne pas afficher ligne 27 les mois de 31 jours
                Set cel = Plage.Columns(8).Find(Date, , xlValues, xlWhole)    ' Colonne 8 = colonne H (Colonne de la date au format Date)
                '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("H" & i)) > 0 Or Weekday(Range("H" & 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
    Call DerniereLigne
End Sub

J'ai oublié que j'ai cette macro aussi

Sub DerniereLigne()
    Dim i&, dat As Date, nb&, fin&, nbj&, col, a&

    Application.ScreenUpdating = 0

    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "MENU" Then
            With Sheets(i)
                fin = .Range("A" & Rows.Count).End(3).Row
                If fin > 4 Then

                If Month("1/" & .Name) < 9 Then
                  dat = .Range("A" & fin)
                Else
                  dat = .Range("H" & fin)
                End If

                    nb = Day(dat)
                    nbj = Day(DateSerial(Year(dat), Month(dat) + 1, 0))
                        If dat = Date Then
                            .Cells(fin, 1).Resize(, 7).Interior.ColorIndex = 17
                        ElseIf Application.CountIf(Sheets("Menu").Range("JoursFériés"), dat) > 0 Or Weekday(dat, vbMonday) > 5 Then
                          .Cells(fin, 1).Resize(, 7).Interior.ColorIndex = 38
                        Else
                            a = 1
                            For Each col In Array(15, 6, 4, 43, 43, 43, 43)
                                .Cells(fin, a).Interior.ColorIndex = col: a = a + 1
                            Next col
                        End If
                End If
            End With
        End If
    Next i
End Sub

La ligne de hier 02/10/2019 reste en interior color 17 alors qu'elle devrait être avec ses couleurs normales suivant les colonnes c'est à dire 15 6 4 43

Si je tape 3 aujourd’hui elle passe bien interior color 17

Je ne suis pas sous MFC volontairement

Merci à vous

Bonjour,

justement, pourquoi "pas de MFC" ?

pour une actualisation automatique, il faudrait aussi une macro workbook_open et une macro worksheet_activate dans ton cas, sinon en effet il ne se passera rien !

Bonjour Steelson

J'en ai 4 qui sont TOUS différents

Je vais essayer de gratter un peu plus et faire des tests pendant quelques et si je ne trouve pas je reviens sur le forum

Donc en attendant je mets Résolu pour éviter de chercher pour rien

Bien cordialement

Bonjour le forum

Comme promis

Il fallait tout simplement ajouter ceci dans la macro

Call DerniereLigne
Private Sub Workbook_Open()
Dim wSheet As Worksheet
Dim Feuille As String, AMasquer As String
Dim i As Integer

  Application.ScreenUpdating = False
  For Each wSheet In Worksheets
    wSheet.Protect UserInterfaceOnly:=True
  Next wSheet

  Feuille = MonthName(Month(Date)) & " " & Year(Date)
  If FeuilleExiste(Feuille) = False Then Exit Sub
  If UCase(Feuille) <> UCase(ActiveSheet.Name) Then
      ' Teste le nom en majuscule de la feuille du mois en cours avec le nom en majuscule de la feuille affichée
    AMasquer = ActiveSheet.Name
    With Sheets(Feuille)
      .Visible = True
      .Select
    End With
    Sheets(AMasquer).Visible = xlSheetVeryHidden
  End If

  For i = 1 To Sheets.Count                                                                     'Pour afficher tous les Mois
    If UCase(Sheets(i).Name) <> UCase(Feuille) Then Sheets(i).Visible = xlSheetVeryHidden       'Pour afficher tous les Mois
  Next i                                                                                        'Pour afficher tous les Mois
Call DerniereLigne
End Sub

Bien cordialement

il faudrait aussi une macro workbook_open

La solution était donc bien là, mais tu n'avais pas montré l'ensemble de ton application !

Bonjour Steelson

Oui quand j'ai vu ta réponse ça a fait tilt

Merci à toi

Bonne journée

Cordialement

Rechercher des sujets similaires à "pourquoi ligne hier reste interior color"