Accepter une donnée dans une cellule si cela ne va pas au-delà d'une date

Bonjour Cher tous.

j'ai créé un petit outil pour mon organisation pour gérer le budget du personnel sur les différentes contributions que reçoivent notre association (chaque contribution d'un donateur a un code projet spécifique et une date limite pour charger diffèrent cout sur les lignes budgétaires). J’ai utilisé la fonction NB.SI pour un peu automatiser et avoir le total de l'argent engagé sous chaque colonne de chaque projet. Mon souci maintenant c'est de pouvoir mettre une restriction de manière à ce que je ne puisse pas choisir un projet en novembre alors que celui-ci finit en juin (dans la colonne des mois, avec validations des données des différents projets en cours).

j'ai trois feuilles. Une avec la planification annuelle pour le personnel, (sur lequel j'essaie de mettre cette restriction), une deuxième pour la disponibilité de budget et une dernière avec la liste des projets disponibles et leur date de fin

Bonjour,

Essayez ceci

Code utilisé dans le module de la feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("M5:X72")) Is Nothing Then
        Creation_Listes
    End If
End Sub

Sub Creation_Listes()
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("Plannification 2022")
    Set f2 = Sheets("ProjectsList")
    If Selection.Column > 12 And Selection.Column < 25 Then 'colonnes de M à X
        MoisSelect = Selection.Column - 12  'on relève le N° du mois correspondant à la cellule sélectionnée
        'on crée la nouvelle liste à partir du mois sélectionné
        ActiveWorkbook.Names.Add Name:="Liste", RefersToR1C1:="=" & f2.Name & "!R" & MoisSelect + 1 & "C1:R13C1"
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & "Liste"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

Merci Beaucoup

Ne sachant pas comment va évoluer votre fichier dans les années à venir, voici une petite modification.

Dans la feuille ""ProjecsList"", les listes sont isolées par année, et le code est recopié dans les modules de chaque feuille avec les références à la feuille "Plannification" et les colonnes de chaque liste adaptées en fonction de l'année, ainsi vous conserverez l'historique des années passées.

je vous ai préparé le fichier jusqu'à l'année 2024, il vous suffira d'appliquer le même principe pour les années suivantes.

Sincerement je ne saurais comment te remercier a part te dire merci beaucoup encore une fois de plus.

Bonjour,

fichier modifié en vue des évolutions futures

Dim Pos_Janv As Long

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Left(ActiveSheet.Name, 14) = "Plannification" Then
        If Not Intersect(Target, Range("E5:X72")) Is Nothing Then
            'détection de la position du mois de janvier
            Pos_Janv = Application.Match("JANV", Range("A3:M3"), 0)
            Creation_Listes
        End If
    End If
End Sub

Sub Creation_Listes()
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets(ActiveSheet.Name)
    Set f2 = Sheets("ProjectsList")
    On Error Resume Next
    ActiveWorkbook.Names("Liste*").Delete 'suppression des listes existantes

    If Selection.Column >= Pos_Janv And Selection.Column <= Pos_Janv + 11 Then 'colonnes de E à P ou de M à X
        MoisSelect = Selection.Column - Pos_Janv + 1 'on relève le N° du mois correspondant à la cellule sélectionnée
        'on crée la nouvelle liste à partir du mois sélectionné
        ActiveWorkbook.Names.Add Name:="Liste", RefersToR1C1:="=" & f2.Name & "!R" & MoisSelect + 2 & "C1:R14C1"
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Liste"
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            .ShowError = True
        End With
    End If
    Set f1 = Nothing
    Set f2 = Nothing
End Sub