Microsoft 365 Interdire L'écriture sur une ligne si la date est dépassée

[sebastien176]

Bonjour à tous,

J’aimerais verrouiller toutes les cellules (liste déroulante) d'une ligne (à partir de la ligne 6) si la date (colonne 2) est dépassée

Si possible j'aimerais qu'il soit quand même possible de pouvoir remplir les cellules jusqu'à 2 jours avants la date du jour

Je vous remercie par avance de votre aide

Vous trouverez le fichier en pièce jointe

Bonne journée

Seb

 

[Lolote83]

Salut SEBASTIEN176,
Voici un petit fichier exemple qui pourrait peut être correspondre à ta demande
@+ Lolote83

 

[sebastien176]

Salut SENASTIEN176,
Voici un petit fichier exemple qui pourrait peut être correspondre à ta demande
@+ Lolote83

Salut Lolote83,

Merci pour ta réponse .... je suis désolé d'avance mais j'ai oublié 2 petites précisions
Je préférerais passer en mode VBA pour avoir un message box pour prévenir l'utilisateur qu'il na peut plus modifier la case car la date est dépassée de plus de 2 jours

Merci quand même pour ton aide

Seb

 

[Lolote83]

Re salut Sebastien176,
Alors, regarde cette discussion, elle devrait peut être t'apporter un début de réponse.
https://www.excel-downloads.com/thr...ivant-une-resultat-dans-une-colonne.20056341/
@+ Lolote83

 

[sebastien176]

Pour info les cases qui contiennent la date sont fusionnées .... donc j'ai refais une colonne qui sera masquer dans le fichier ci-joint
j'ai également essayer avec ce code mais il y a des bugs

Merci d'avance de vos réponses

'Interdire la saisie quand la date est dépassée sur la feuille
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'If Not Intersect(Target, Range("E7:ZZ1200")) Is Nothing Then
'jour = Cells(3, Target.Column).Value
'If Date - 1 > jour Then
'MsgBox ("Vous ne pouvez pas revenir à une date précedente")
'[A1].Select
'Exit Sub
'End If

'If jour > Date + 1 Then
'MsgBox ("Vous ne pouvez pas remplir à l'avance")
'[A1].Select
'Exit Sub
'End If

'End If
'End Sub

 

[fanch55]

Bonjour à tous,
Classeur adapté à tester.
Seule la feuille Suivi TPM Emballage a été impactée :
Ajout

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range

    Select Case True
        Case Target.Count > 1
        Case Intersect(Target, [D7:T1119]) Is Nothing
        Case Not CheckDate
            Application.EnableEvents = False
            Set R = Columns("B").Find(Format(Date - 2, "dddd dd mmmm"), LookIn:=xlValues)
            If Not R Is Nothing Then Cells(R.Row, "B").Select Else Cells(Target.Row, "B").Select
            Application.EnableEvents = True
    End Select
End Sub
Function CheckDate() As Boolean
Dim Refdate As Date
    
    CheckDate = True
    Refdate = Cells(Selection.Row, "B").MergeArea.Cells(1).Value
    
    Select Case Date
        Case Is > Refdate + 2:  MsgBox "trop tard": CheckDate = False
        Case Is >= Refdate + 1: MsgBox "il est temps"
        Case Else
    End Select
    
End Function

Modifié: ( ne devrait pas se déclencher sauf si modif par code .)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fait, x As String

Dim R As Range
    Select Case True
        Case Target.Count > 1
        Case Intersect(Target, [D7:T1119]) Is Nothing
        Case Not CheckDate
            Application.EnableEvents = False
            Application.Undo
            Set R = Columns("B").Find(Format(Date - 2, "dddd dd mmmm"), LookIn:=xlValues)
            If Not R Is Nothing Then Cells(R.Row, "B").Select Else Cells(Target.Row, "B").Select
            Application.EnableEvents = True
    End Select

fait = ActiveCell.Value
.....
.....

 

[job75]

Bonjour sebastien176, Lolote83, fanch55,

Si j'ai bien compris cette macro doit faire l'affaire :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Variant
lig = Application.Match(CDbl(Date - 2), [B:B])
If IsError(lig) Then Exit Sub
If Intersect(Target, Rows("7:" & lig + 2)) Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
Application.Undo 'annule les modifications
Application.EnableEvents = True 'réactive les évènements
End Sub

Dans le fichier joint j'ai supprimé la colonne des dates C qui ne servait à rien.

A+

 

[sebastien176]

Bonjour à tous et un grand merci également

Je prends toutes vos suggestions