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.
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
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.
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.
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.
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.
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