XL 2019 Verrouiller des lignes si Date

B

btakeshi

XLDnaute Nouveau
Bonjour à vous,

Je suis débutant en Excel et j’ai besoin de l’aide.

La colonne A de ma feuille contient des dates, je souhaite interdire toutes modifications et/ou suppression d’une ligne si la date déjà saisie est inférieure à la date d’aujourd’hui.

Je sollicite aussi votre aide pour contourner le problème du changement manuellement des dates sur l’ordinateur qui permettre de contourner cette interdiction.

Merci pour votre temps.
 

Pièces jointes

  • Date.xlsx
    9 KB · Affichages: 16
Trier par date Trier par votes
S

soan

XLDnaute Barbatruc
Inactif
Bonsoir btakeshi, ivan27,

Je propose cette optimisation du code VBA d'ivan27 :
VB: 
Private Sub Worksheet_Activate()
  Dim cel As Range, dlg&: ActiveSheet.Unprotect
  dlg = Cells(Rows.Count, 1).End(3).Row
  For Each cel In Range("A2:A" & dlg)
    cel.Locked = cel < Date
  Next cel
  ActiveSheet.Protect
End Sub
soan
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour btakeshi, ivan27, soan,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, dat As Variant, flag As Boolean
Application.ScreenUpdating = False
tablo = Range("A1", UsedRange).Resize(, 2) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo): d(tablo(i, 1) & tablo(i, 2)) = "": Next
Application.EnableEvents = False 'désactive les évènements
Application.Undo 'annule les modifications
tablo = Range("A1", UsedRange).Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    dat = tablo(i, 1): flag = False
    If dat = "Date" Then flag = True 'en-tête
    If IsDate(dat) Then If CDate(dat) < Date Then flag = True
    If flag Then If Not d.exists(tablo(i, 1) & tablo(i, 2)) Then GoTo 1
Next
Application.Undo 'rétablit les modifications
1 Application.EnableEvents = True 'réactive les évènements
End Sub
Les lignes des dates écoulées et les en-têtes ne peuvent pas être modifiées ou supprimées.

Il n'y a pas besoin de protéger la feuille.

A+
 

Pièces jointes

  • Date(1).xlsm
    17.3 KB · Affichages: 8
Vote positif 0 Vote négatif
A

Arkinoxs

XLDnaute Nouveau
job75 à dit:
Bonjour btakeshi, ivan27, soan,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, dat As Variant, flag As Boolean
Application.ScreenUpdating = False
tablo = Range("A1", UsedRange).Resize(, 2) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo): d(tablo(i, 1) & tablo(i, 2)) = "": Next
Application.EnableEvents = False 'désactive les évènements
Application.Undo 'annule les modifications
tablo = Range("A1", UsedRange).Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    dat = tablo(i, 1): flag = False
    If dat = "Date" Then flag = True 'en-tête
    If IsDate(dat) Then If CDate(dat) < Date Then flag = True
    If flag Then If Not d.exists(tablo(i, 1) & tablo(i, 2)) Then GoTo 1
Next
Application.Undo 'rétablit les modifications
1 Application.EnableEvents = True 'réactive les évènements
End Sub
Les lignes des dates écoulées et les en-têtes ne peuvent pas être modifiées ou supprimées.

Il n'y a pas besoin de protéger la feuille.

A+
Cliquez pour agrandir...
Salut comment l'adapter sur plusieurs colonne d'une même ligne?
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Arkinxs, bienvenue sur XLD, le fil, le forum,

Bravo, vous avez bien fait de revenir sur ce fil, la question est intéressante, voyez ce fichier (2).

Pour traiter plusieurs colonnes il faut concaténer les éléments de chaque ligne du tableau :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, x As Variant, dat As Variant, flag As Boolean
With Application
    .ScreenUpdating = False
    tablo = Range("A1", UsedRange) 'matrice, plus rapide
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo)
        x = .Index(tablo, i, 0) 'ligne du tableau
        x = Join(.Transpose(.Transpose(x)), Chr(1)) 'concaténation avec séparateur
        d(x) = ""
    Next
    .EnableEvents = False 'désactive les évènements
    .Undo 'annule les modifications
    tablo = Range("A1", UsedRange) 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        dat = tablo(i, 1): flag = False
        If dat = "Date" Then flag = True 'en-tête
        If IsDate(dat) Then If CDate(dat) < Date Then flag = True
        If flag Then
            x = .Index(tablo, i, 0) 'ligne du tableau
            x = Join(.Transpose(.Transpose(x)), Chr(1)) 'concaténation avec séparateur
            If Not d.exists(x) Then GoTo 1
        End If
    Next
    .Undo 'rétablit les modifications
1   .EnableEvents = True 'réactive les évènements
End With
End Sub
Bien voir que la fonction Join ne concatène qu'un tableau à 1 dimension, d'où les Transpose.

A+
 

Pièces jointes

  • Date(2).xlsm
    18.6 KB · Affichages: 3
Vote positif 0 Vote négatif
A

Arkinoxs

XLDnaute Nouveau
job75 à dit:
Bonjour Arkinxs, bienvenue sur XLD, le fil, le forum,

Bravo, vous avez bien fait de revenir sur ce fil, la question est intéressante, voyez ce fichier (2).

Pour traiter plusieurs colonnes il faut concaténer les éléments de chaque ligne du tableau :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, x As Variant, dat As Variant, flag As Boolean
With Application
    .ScreenUpdating = False
    tablo = Range("A1", UsedRange) 'matrice, plus rapide
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo)
        x = .Index(tablo, i, 0) 'ligne du tableau
        x = Join(.Transpose(.Transpose(x)), Chr(1)) 'concaténation avec séparateur
        d(x) = ""
    Next
    .EnableEvents = False 'désactive les évènements
    .Undo 'annule les modifications
    tablo = Range("A1", UsedRange) 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        dat = tablo(i, 1): flag = False
        If dat = "Date" Then flag = True 'en-tête
        If IsDate(dat) Then If CDate(dat) < Date Then flag = True
        If flag Then
            x = .Index(tablo, i, 0) 'ligne du tableau
            x = Join(.Transpose(.Transpose(x)), Chr(1)) 'concaténation avec séparateur
            If Not d.exists(x) Then GoTo 1
        End If
    Next
    .Undo 'rétablit les modifications
1   .EnableEvents = True 'réactive les évènements
End With
End Sub
Bien voir que la fonction Join ne concatène qu'un tableau à 1 dimension, d'où les Transpose.

A+
Cliquez pour agrandir...
Bonjour,
Merci pour ta réponse, nous avons effectivement un ligne complète qui ne peut être modifié avec ce code. :)
Entre temps j'ai trouvé un code VBA que j'ai modifié afin d'obtenir l'option de choisir chaque colonne de la ligne dont nous avons besoin de verrouiller lorsque la date d'une cellule de la même ligne est antérieur à aujourd'hui. Voici :
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim xRow As Long
  xRow = 2
  ThisWorkbook.ActiveSheet.Unprotect Password:="123"
  ThisWorkbook.ActiveSheet.Cells.Locked = False
  'Lechiffre "1" ci dessous est celui de la colonne contenant la date
  Do Until IsEmpty(Cells(xRow, 1))
    If Cells(xRow, 1) < Date Then
'Les chiffre ci-dessous sont les colonnes à être verouillé(on peut en ajouter ou enlever selon le besoin)
       Cells(xRow, 1).Locked = True
       Cells(xRow, 2).Locked = True
       Cells(xRow, 3).Locked = True
       Cells(xRow, 4).Locked = True
       Cells(xRow, 5).Locked = True
       Cells(xRow, 6).Locked = True
       Cells(xRow, 7).Locked = True
       Cells(xRow, 8).Locked = True
    End If
    xRow = xRow + 1
  Loop
  ThisWorkbook.ActiveSheet.Protect Password:="123"
End Sub
 

Pièces jointes

  • Date(3).xlsm
    54.8 KB · Affichages: 2
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Création d'une formule de recherche avec critère
Réponses
6
Affichages
406
Sunny36
S
M
  • Question
Microsoft 365 Formule "SI" avec des dates intégrées
Réponses
3
Affichages
320
sylvanu
sylvanu
A
  • Question
XL 2019 format de date dans un résultat de concaténation
Réponses
8
Affichages
475
Akafal
A
Y
  • Résolu(e)
XL 2016 Pb dates inversées dans userform
2 3
Réponses
37
Affichages
2 K
YOUYOU25
Y
S
  • Résolu(e)
Microsoft 365 Verrouiller des lignes si la date est dépassée
Réponses
5
Affichages
707
sebastien176
S
Y
  • Résolu(e)
XL 2016 Afficher et masquer les lignes en fonction des critères
Réponses
14
Affichages
572
YANNISE
Y
D
  • Résolu(e)
Microsoft 365 Numérotation en boucle selon la date
Réponses
6
Affichages
477
domichou
D
O
  • Question
Microsoft 365 détermination droites plafond à l'aide des fonction PENTE et ORIGINE
2
Réponses
15
Affichages
1 K
sylvanu
sylvanu
L
  • Question
XL 2016 Calcul à partir d'une date précise ou - à défaut - à partir de la date qui suit immédiatement après
Réponses
4
Affichages
562
Lorenzini
L
Droopyougo
  • Question
Microsoft 365 Copier la valeur de cellules non contigües de plusieurs feuilles vers une feuille récapitulative.
Réponses
14
Affichages
1 K
Droopyougo
Droopyougo

Membres actuellement en ligne

14 membres et 105 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 705
Messages
2 112 077
Membres
111 411
dernier inscrit
NIMY