VBA , =Date -1 jour en sautant le weekend

Bonjour,

Je veux que la date affichée sois toujours des jour ouvrable. lundi -1 jour dois donner vendredi précédant.

Sur cette ligne précisément.

Case "2/2 BETON FAIT": Cel.Interior.ColorIndex = 10: Cells(Target.Row, 38) = Date - 1

Merci d'avance

Private Sub WorkSheet_Change(ByVal Target As Range) 'code pour la couleur spéciaux (modifiaction date actuelle statut)
If Target.Column = 13 Then
Cells(Target.Row, 12) = Now



End If
Dim Cel As Range
For Each Cel In Target
If Not Intersect(Cel, Range("m44:m39000")) Is Nothing Then
Select Case Cel.Value
Case "PLANIFIÉ": Cel.Interior.ColorIndex = 8: Cells(Target.Row, 1) = Date
Case "RECU DESSIN": Cel.Interior.ColorIndex = 23: Cells(Target.Row, 2) = Date
Case "1/2 BETON FAIT": Cel.Interior.ColorIndex = 4
Case "2/2 BETON FAIT": Cel.Interior.ColorIndex = 10: Cells(Target.Row, 38) = Date - 1
Case "100% PEINTURE ": Cel.Interior.ColorIndex = 46
Case "fermet. ou non-appr": Cel.Interior.ColorIndex = 6
Case "PRET A EXPEDIER": Cel.Interior.ColorIndex = 48
Case "100% NETTOYÉ": Cel.Interior.ColorIndex = 19
Case "HOLD OU REVISION": Cel.Interior.ColorIndex = 3
Case "PEINTURE 1 DE 2": Cel.Interior.ColorIndex = 44
Case "PEINTURE 2 DE 2": Cel.Interior.ColorIndex = 45
Case "PEINTURE 3 DE 3": Cel.Interior.ColorIndex = 46
Case Else: Cel.Interior.ColorIndex = 2
End Select
End If
Next Cel
End Sub

Bonsoir,

Dans un module standard :

Function JourMoins1(ByVal DateChoisie As Date) As Date

    Select Case Weekday(DateChoisie, vbMonday)
           Case 1
              JourMoins1 = DateChoisie - 3
           Case 7
              JourMoins1 = DateChoisie - 2
           Case Else
              JourMoins1 = DateChoisie - 1
    End Select

End Function

Dans le module de votre onglet :

Option Explicit

Private Sub WorkSheet_Change(ByVal Target As Range) 'code pour la couleur spéciaux (modifiaction date actuelle statut)

Dim Cel As Range

    If Target.Column = 13 Then Cells(Target.Row, 12) = Now

    For Each Cel In Target
        If Not Intersect(Cel, Range("m44:m39000")) Is Nothing Then
            Select Case Cel.Value
                Case "PLANIFIÉ": Cel.Interior.ColorIndex = 8: Cells(Target.Row, 1) = Date
                Case "RECU DESSIN": Cel.Interior.ColorIndex = 23: Cells(Target.Row, 2) = Date
                Case "1/2 BETON FAIT": Cel.Interior.ColorIndex = 4
                Case "2/2 BETON FAIT": Cel.Interior.ColorIndex = 10: Cells(Target.Row, 38) = JourMoins1(Date)
                Case "100% PEINTURE ": Cel.Interior.ColorIndex = 46
                Case "fermet. ou non-appr": Cel.Interior.ColorIndex = 6
                Case "PRET A EXPEDIER": Cel.Interior.ColorIndex = 48
                Case "100% NETTOYÉ": Cel.Interior.ColorIndex = 19
                Case "HOLD OU REVISION": Cel.Interior.ColorIndex = 3
                Case "PEINTURE 1 DE 2": Cel.Interior.ColorIndex = 44
                Case "PEINTURE 2 DE 2": Cel.Interior.ColorIndex = 45
                Case "PEINTURE 3 DE 3": Cel.Interior.ColorIndex = 46
                Case Else: Cel.Interior.ColorIndex = 2
            End Select
        End If
    Next Cel

End Sub

Cells(Target.Row, 38) = WorksheetFunction.WorkDay(Date, -1)