Ajout d'une date automatique selon un menu déroulant

Bonjour à tous !

Voilà mon casse-tête : je souhaiterais renseigner une date automatiquement à partir de la date d'une autre cellule. Je m'explique.

Admettons :

En A1 (jj/mm/aaaa hh:mm), j'ai renseigné la date suivante : 29/03/2021 11:41 (lundi)

Au changement de cette cellule, je souhaiterais qu'une boîte de dialogue apparaisse avec les choix :

* Jour
* Fin de semaine
* Fin de mois
* Fois de mois suivant
* Toute l'année

Lorsque «Jour» est sélectionné, une nouvelle date en A2 s'insère automatiquement, à savoir (à partir de mon exemple) : 29/03/2021 23:59

La difficulté réside ici à présent :

Si je sélectionne «Fin de semaine», je souhaite qu'une nouvelle date s'insère en excluant les samedis et dimanches...

Dans mon exemple, la nouvelle date insérée automatiquement serait 02/04/2021 23:59 (vendredi) et non 04/04/2021 23:59 (dimanche)

Pareil pour le choix «Fin de mois», à partir de mon exemple, la date serait : 31/03/2021 23:59 (mercredi)

Pour «Fin de mois suivant», nous aurions la dernière date du mois suivant en excluant les samedis et dimanches, donc 30/04/2021 23:59 (vendredi)

Mais si le 30/04/2021 avait été un samedi, nous aurions eu 29/04/2021 23:59

Pour toute l'année cette fois, nous aurions comme résultat : 25/03/2021 23:59 (vendredi)

Merci d'avance de votre aide, soutien et autres contributions précieuses !

Salut Aargo!,

pas pris le temps de vérifier sur plusieurs dates : tu feras bien, hein, oui ?
Clique en [C1] pour le choix du délai.

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim dDate As Date, dDate2 As Date, iIdx%
'
If Not Intersect(Target, [C1]) Is Nothing Then
    dDate = DateValue([A1])
    Select Case Target
        Case "Jour"
            [A2] = DateAdd("n", -1, DateAdd("d", 1, dDate))
        Case "Fin de semaine"
            iIdx = IIf(5 - Weekday(dDate, vbMonday) >= 0, 5 - Weekday(dDate, vbMonday), 12 - Weekday(dDate, vbMonday))
            [A2] = DateAdd("d", iIdx, dDate)
        Case "Toute l'année"
            [A2] = DateAdd("n", -1, DateAdd("d", 1, DateAdd("yyyy", 1, dDate)))
        Case Else
            dDate2 = DateAdd("d", IIf(Target = "Fin de mois", -1, -2), DateAdd("m", 1, DateSerial(Year(dDate), Month(dDate), 1)))
            iIdx = IIf(Weekday(dDate2, vbMonday) <= 5, 0, 5 - Weekday(dDate2, vbMonday))
            [A2] = DateAdd("d", iIdx, dDate2)
    End Select
End If
'
End Sub

Bonjour curulis57 et merci de ton retour, c'est top !

J'ai modifié un peu l'architecture du fichier pour répondre à mon besoin (c-a-d un menu déroulant + résultat par ligne). ça marche nickel !

Néanmoins, j'ai testé quelques dates un peu ambiguës.

Notamment pour l'option "toute l'année" qui tombe le samedi 4 juin 2022 dans mon exemple (au lieu du vendredi 3 juin 2022).

Idem pour l'option "fin de mois suivant" qui ne m'affiche pas le mois suivant et semble me retourner le même résultat que l'option "fin de mois".

Pour le reste, j'aimerais indiquer 23:59 au lieu de 00:00

Ci-joint, j'ai mis en colonne D les résultats que je souhaiterais obtenir. Ce sera plus parlant ! Encore merci !!

PS : Suite à mes modifications, j'ai une petite erreur d'exécution '91' : Variable objet ou variable de bloc With non définie

Salut Aargol,

ton fichier corrigé..

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim dDate As Date, dDate2 As Date, iIdx%, iRow%
'
iRow = Target.Row
'
If Not Intersect(Target, Columns(2)) Is Nothing And Range("A" & Target.Row).Value <> "" Then
    dDate = DateValue(Range("A" & iRow).Value)
    Select Case Target
        Case "Jour", "Fin de semaine"
            dDate2 = dDate
            If Target <> "Jour" Then iIdx = IIf(5 - Weekday(dDate, vbMonday) >= 0, 5 - Weekday(dDate, vbMonday), 12 - Weekday(dDate, vbMonday))
        Case "Toute l'année"
            dDate2 = DateAdd("yyyy", 1, dDate)
            iIdx = IIf(Weekday(dDate2, vbMonday) <= 5, 0, 5 - Weekday(dDate2, vbMonday))
        Case Else
            dDate2 = DateAdd("d", -1, DateAdd("m", IIf(Target = "Fin de mois", 1, 2), DateSerial(Year(dDate), Month(dDate), 1)))
            iIdx = IIf(Weekday(dDate2, vbMonday) <= 5, 0, 5 - Weekday(dDate2, vbMonday))
    End Select
    Range("C" & iRow) = DateAdd("n", -1, DateAdd("d", iIdx + 1, dDate2))
End If
'
End Sub

A+

Plus "compressé"...

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim dDate As Date, dDate2 As Date, iIdx%
'
If Not Intersect(Target, Columns(2)) Is Nothing And Range("A" & Target.Row).Value <> "" Then
    dDate = DateValue(Range("A" & Target.Row).Value)
    If Target = "Jour" Or Target = "Fin de semaine" Then
        dDate2 = dDate
        If Target <> "Jour" Then iIdx = IIf(5 - Weekday(dDate, vbMonday) >= 0, 5 - Weekday(dDate, vbMonday), 12 - Weekday(dDate, vbMonday))
    Else
        dDate2 = IIf(Target = "Toute l'année", DateAdd("yyyy", 1, dDate), _
            DateAdd("d", -1, DateAdd("m", IIf(Target = "Fin de mois", 1, 2), DateSerial(Year(dDate), Month(dDate), 1))))
        iIdx = IIf(Weekday(dDate2, vbMonday) <= 5, 0, 5 - Weekday(dDate2, vbMonday))
    End If
    Range("C" & Target.Row) = DateAdd("n", -1, DateAdd("d", iIdx + 1, dDate2))
End If
'
End Sub

A+