- Du coup, cela ajoute autant de lignes que de colonnes en plus de la suppression d'une ligne. Mais au final on trace bien un événement. => on peut néanmoins améliorer ce point
proposition
et dans la mesure où on restreint le champ à la base de données, on peut autoriser la suppression d'une ligne complète d la feuille
Option Explicit
Private Sub Worksheet_change(ByVal cible As Range)
Dim avant, apres, idavant As Object, idapres As Object, log As Worksheet, cle As Variant
Dim memoire As Range, plage As Range, cel As Range, ecart As String
Dim i%, j%, n%, flag As Boolean
On Error GoTo fin
If Not Intersect(cible, ActiveSheet.ListObjects(1).DataBodyRange) Is Nothing Then
Set memoire = Selection
Set log = Sheets("Log")
' contrôle des identifiants uniques
apres = ActiveSheet.ListObjects(1).ListColumns("ID").DataBodyRange
Set idapres = CreateObject("Scripting.Dictionary")
Set idavant = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(apres)
If apres(i, 1) = "" Then
MsgBox "Manque identifiant !"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
If idapres.exists(apres(i, 1)) Then
MsgBox "Les identifiants doivent être uniques !"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
idapres(apres(i, 1)) = ""
Next
' traitement des modifications
Application.EnableEvents = False
With ActiveSheet.ListObjects(1)
Set plage = Intersect(cible, .DataBodyRange)
apres = .DataBodyRange
For i = 1 To UBound(apres)
idapres(apres(i, 1)) = ""
Next
Application.Undo
avant = .DataBodyRange
For i = 1 To UBound(apres)
idavant(avant(i, 1)) = ""
Next
Application.Undo
flag = True
' taille du tableau
If UBound(apres) > UBound(avant) Then
loguer "", "", "", "", "La BdD a augmenté de " & -UBound(avant) + UBound(apres) & " ligne(s)"
For i = UBound(avant) + 1 To UBound(apres)
For j = 1 To UBound(apres, 2)
If apres(i, j) <> "" Then
loguer .DataBodyRange(i, 1), j, "", apres(i, j), ""
End If
Next
Next
End If
If UBound(apres) < UBound(avant) Then
ecart = ""
For Each cle In idavant
If Not idapres.exists(cle) Then ecart = ecart & "/" & cle
Next
loguer "", "", "", "", "La BdD a diminué de " & UBound(avant) - UBound(apres) & " ligne(s)" & vbCrLf & ecart
flag = False
End If
If UBound(apres, 2) > UBound(avant, 2) Then
loguer "", "", "", "", "La BdD s'est élargie de " & -UBound(avant, 2) + UBound(apres, 2) & " colonne(s)"
For i = 1 To UBound(apres)
For j = UBound(avant, 2) + 1 To UBound(apres, 2)
If apres(i, j) <> "" Then
loguer .DataBodyRange(i, 1), j, "", apres(i, j), ""
End If
Next
Next
End If
If UBound(apres, 2) < UBound(avant, 2) Then
loguer "", "", "", "", "La BdD s'est rétrécie de " & UBound(avant, 2) - UBound(apres, 2) & " colonne(s)"
flag = False
End If
' cas standard
n = plage.Cells.Count
If n > 0 And flag Then
For Each cel In plage
i = cel.Row - .HeaderRowRange.Cells(1, 1).Row
j = cel.Column - .HeaderRowRange.Cells(1, 1).Column + 1
If i <= UBound(avant) And i <= UBound(apres) And j <= UBound(avant, 2) And j <= UBound(apres, 2) Then
If avant(i, j) <> apres(i, j) Then
loguer .DataBodyRange(i, 1), j, avant(i, j), apres(i, j), ""
End If
End If
Next
End If
End With
Application.EnableEvents = True
End If
If Not memoire Is Nothing Then memoire.Select
fin:
Application.EnableEvents = True
If Err Then MsgBox "Erreur #" & Err.Number & " !"
End Sub
Sub loguer(id, colonne, avant, apres, commentaire)
Dim ligne%
'Date & heure ID Ligne Colonne Avant Après Commentaire Lien vers … Auteur
With Sheets("Log").ListObjects(1)
.ListRows.Add
ligne = .ListRows.Count
With .DataBodyRange
.Cells(ligne, 1) = Now
.Cells(ligne, 2) = id
.Cells(ligne, 4) = colonne
.Cells(ligne, 5) = avant
.Cells(ligne, 6) = apres
.Cells(ligne, 7) = commentaire
.Cells(ligne, 9) = utilisateur
.Cells(ligne, 10) = Environ("username")
End With
End With
End Sub
pour moi c'est plus un exercice de style, car il y aura de toute façon des situations difficiles à retracer quand on modifie les ID
et puis le code devient trop long, trop complexe