Effacer après minuit la couleur d'une ligne SANS MFC

[un internaute]

Bonjour le forum
Comment faire effacer après minuit la couleur interior color 17d'une ligne par MFC
Mes ligne vont de A6 à G31
Merci pour vos éventuels retours
Cordialement

 

[Philippe_JOCHMANS]

Re

C'était juste un exemple pour la gestion du temps, ensuite tu fais ce que tu veux en jouant sur Interieur.color, etc ...

Philippe

 

[un internaute]

Re
Ah! ok
Bon je vais essayé de m'y "atteler"!!!
Un GRAND merci Philippe
Je reviens lorsque je l'aurais fait "tourner" pendant quelques jours.
Bonne journée à toi et au forum

 

[un internaute]

Bonjour[U]Philippe_JOCHMANS[/U] & le forum
Voici la solution:

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
    If UCase(Sheets(I).Name) <> UCase(Feuille) Then Sheets(I).Visible = xlSheetVeryHidden
  Next I

  Colorise_Le_Mois Day(DateAdd("m", 1, DateValue(ActiveSheet.Name)) - 1)

End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim NombreJour&, Ladate As Date, MoisSuivant$
    
    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) = "", "", 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
          Colorise_Le_Mois NombreJour
        End If
      End If
    End If
    Application.EnableEvents = True

End Sub
          
Sub Colorise_Le_Mois(NombreJour)

  Dim Cel As Range, Plage As Range, F As String, J As Integer, I As Integer
 
  Application.ScreenUpdating = False
 
  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
  '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
  Call DerniereLigne
End Sub