Pense bête !

[JBARBE]

Bonjour à tous,

Il y a quelques années j'ai fait une macro ( que je trouve trop compliquée) pour un pense bête automatisé
Suivant une date en colonne B!

Les dates non renouvelées en colonne E ( exemple 365 jours pour 1 an renouvelées automatiquement) sont
envoyées dans la feuille "Date_Terminée" !

La ligne concernée se colorie en rouge + un msgbox pour la date du jour !

La ligne concernée se colorie en jaune + un msgbox pour la date du jour -1 !

La ligne concernée se colorie en vert + un msgbox pour la date du jour >1 et =< 5!

La colonne F indique le nombre de jours restant en rouge !

Dim i As Integer
Dim k As Integer
Dim h As Integer
Sub Selectionner()
Application.ScreenUpdating = False
Sheets("Date_En_Cours").Select
Range("B2").Select
For i = 1 To 10000 ''''' debut i
If Cells(i, 2).Value = "" Then Exit For
If Cells(i, 1).Interior.ColorIndex = xlNone Then
  Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 24
  ElseIf Cells(i, 2).Value = Date + 1 Then
    MsgBox Cells(i, 1) & "  à venir le  " & Cells(i, 2) & "  à Heure  " & Cells(i, 3) & "  J" & Date - Cells(i, 2)
    Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 6
    Cells(i, 6).Value = Date - Cells(i, 2)
    Cells(i, 6).Font.ColorIndex = 3
    Cells(i, 6).Font.Bold = True
    Cells(i, 6).Interior.ColorIndex = 6
ElseIf Cells(i, 2).Value = Date + 2 Or Cells(i, 2).Value = Date + 3 Or Cells(i, 2).Value = Date + 4 Or Cells(i, 2).Value = Date + 5 Then
    MsgBox Cells(i, 1) & "  à venir le  " & Cells(i, 2) & "  à Heure  " & Cells(i, 3) & "  J" & Date - Cells(i, 2)
    Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 8
    Cells(i, 6).Value = Date - Cells(i, 2)
    Cells(i, 6).Font.ColorIndex = 3
    Cells(i, 6).Font.Bold = True
    Cells(i, 6).Interior.ColorIndex = 8
ElseIf Cells(i, 2).Value < Date And Cells(i, 5).Value = "" Then
     Range(Cells(i, 1), Cells(i, 4)).Copy
     Sheets("Date_Terminée").Select
     Cells(2, 2).Select
       For k = 1 To 10000 ''''' debut k
         If Cells(k, 2).Value = "" Then
         ActiveSheet.Paste
         Application.CutCopyMode = False
         Range(Cells(k, 2), Cells(k, 6)).Interior.ColorIndex = xlNone
         Sheets("Date_En_Cours").Select
         Exit For
         Else
         Cells(k + 1, 2).Select
         End If
         Next k  ''''' fin k
         Range("B2").Select
         For h = 1 To 1000 ''''' debut h
         If Cells(h, 2).Value = "" Then Exit For
          If Cells(h, 2).Value < Date Then
         Cells(h, 2).EntireRow.Delete
         Exit For
         Else
         Cells(h + 1, 2).Select
         End If
         Next h ''''' fin h
ElseIf Cells(i, 2).Value = Date Then
    MsgBox Cells(i, 1) & "  AUJOURD'HUI le  " & Cells(i, 2) & "  à Heure  " & Cells(i, 3)
     Range(Cells(i, 1), Cells(i, 4)).Interior.ColorIndex = 3
     Cells(i, 6).Value = Date - Cells(i, 2)
    Cells(i, 6).Font.ColorIndex = 3
    Cells(i, 6).Font.Bold = True
    Cells(i, 6).Interior.ColorIndex = 8
ElseIf Cells(i, 2).Value < Date And Cells(i, 5).Value = "" Then
     Range(Cells(i, 1), Cells(i, 4)).Interior.ColorIndex = 35
     Cells(i, 6).Clear
     Cells(i, 3).Clear
ElseIf Cells(i, 2).Value < Date And Cells(i, 5).Value <> "" Then
Cells(i, 2).Value = Cells(i, 2) + Cells(i, 5)
Cells(i, 6).Clear
Cells(i, 3).Clear
Range(Cells(i, 1), Cells(i, 4)).Interior.ColorIndex = xlNone
ElseIf Cells(i, 2).Value < DateSerial(Year(Date), Month(Date), Day(Date) + 15) Then
Cells(i, 6).Value = Cells(i, 2) - Date
Cells(i, 6).Font.ColorIndex = 3
Cells(i, 6).Font.Bold = True
Else
Cells(i + 1, 2).Select
End If
     Next i ''''' fin i
Application.ScreenUpdating = True
End Sub

Ce code ne fonctionne pas bien et ne me satisfait pas !

Merci pour vos suggestions !

 

[Papou-net]

Re : Pense bête !

Bonjour JBARBE,

J'ai commencé à étudier ta macro, mais elle est d'une telle complexité que j'ai du mal à m'y retrouver.

Il serait bon, pour me permettre de reprendre à zéro, avec simplification à la clé, que tu établisses une liste des actions à effectuer en fonction de la date située en colonne B.

Par exemple :

Si B2 < Date + 15
- 2 = B.. - Date
- F2 Font.ColorIndex = 3
- F2 Font.Bold = True

Si B2 = Date +1
- MsgBox A2 "à venir le " & B2 & " à Heure " & C2 & " J" & Date - B2
- A2:F2 Interior.ColorIndex = 6
- F2 = Date - B2
- F2 Font.colorIndex = 3

Et ainsi de suite.

A bientôt.

Cordialement.

 

[JBARBE]

Re : Pense bête !

Merci PAPOU je vais essayer de refaire une macro plus claire !

Bonne soirée !