Adaptation d'un code pour traçabilité
Bonjour au forum,
J'ai trouvé ce code sur la toile permettant de tracer les connexions et modifications des utilisateurs d'un fichier excel et de stocker ces données dans un fichier.txt :
Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lpBuff As String * 25
Dim ret As Long
Dim UserName As String, Spy As String, ThePath
ret = GetUserName(lpBuff, 25)
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
ThePath = "O:\Blablabla\Spy.txt" ' à adapter au réseau
Spy = _
Format(Now, "DD/MM/YYYY HH MM SS") & vbTab & _
"User Name : " & UserName & vbTab & _
Sh.Name & vbTab & Target.Address & vbTab & Target.Cells(1, 1)
Open ThePath For Append As #1
Print #1, Spy
Close
End Sub
J'aimerais l'adapter à un de mes fichiers, en modifiant 2 paramètres, mais c'est hors de mes compétences... :
- J'utilise un UserForm pour l'identification des utilisateurs (le login se renseigne dans la TextBox1 de l'Userform3), donc j'aimerais récupérer cette donnée plutôt que le login "Windows"
- J'aimerais que la traçabilité soit affichée dans une feuille de mon classeur (que j'appellerai "Log"), et non pas dans un fichier externe
Auriez-vous une proposition ?
Merci d'avance
Bonjour,
A mettre dans le module du classeur :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Nom As Name
Dim Ligne As Long
If Sh.Name = "Log" Then Exit Sub
Set Nom = ThisWorkbook.Names("NomUtilisateur")
Application.EnableEvents = False
With Worksheets("Log")
.Cells(1, 1).Value = "Utilisateur"
.Cells(1, 2).Value = "Date"
.Cells(1, 3).Value = "Heure"
.Cells(1, 4).Value = "Feuille"
.Cells(1, 5).Value = "Cellule"
.Cells(1, 6).Value = "Valeur"
Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, 1).Value = Replace(Right(Nom.Value, Len(Nom.Value) - 1), """", "")
.Cells(Ligne, 2).Value = Format(Date, "dd/mm/yyyy")
.Cells(Ligne, 3).Value = Format(Time, "hh:mm:ss")
.Cells(Ligne, 4).Value = Sh.Name
.Cells(Ligne, 5).Value = Target.Address(0, 0)
.Cells(Ligne, 6).Value = Target.Value
End With
Application.EnableEvents = True
End Sub
et ceci dans le module du Formulaire afin de stocker le nom d'utilisateur dans un Nom, à adapter :
Private Sub CommandButton1_Click()
Dim Nom As Name
Dim NomUtilisateur As String
On Error Resume Next
Set Nom = ThisWorkbook.Names("NomUtilisateur")
If Err.Number = 0 Then
Nom.Value = Me.TextBox1.Text
Else
ThisWorkbook.Names.Add "NomUtilisateur", Me.TextBox1.Text, False
End If
Unload Me
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'oblige la saisie du nom
If TextBox1.Text = "" Then
MsgBox "Vous devez saisir votre nom !"
Cancel = True
End If
End Sub
Re,
si une formule est entrée, elle sera aussi enregistrée :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Nom As Name
Dim Ligne As Long
If Sh.Name = "Log" Then Exit Sub
Set Nom = ThisWorkbook.Names("NomUtilisateur")
Application.EnableEvents = False
With Worksheets("Log")
.Cells(1, 1).Value = "Utilisateur"
.Cells(1, 2).Value = "Date"
.Cells(1, 3).Value = "Heure"
.Cells(1, 4).Value = "Feuille"
.Cells(1, 5).Value = "Cellule"
.Cells(1, 6).Value = "Formule"
.Cells(1, 7).Value = "Valeur"
Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, 1).Value = Replace(Right(Nom.Value, Len(Nom.Value) - 1), """", "")
.Cells(Ligne, 2).Value = Format(Date, "dd/mm/yyyy")
.Cells(Ligne, 3).Value = Format(Time, "hh:mm:ss")
.Cells(Ligne, 4).Value = Sh.Name
.Cells(Ligne, 5).Value = Target.Address(0, 0)
.Cells(Ligne, 6).Value = IIf(Target.HasFormula, "'" & Target.FormulaLocal, "")
.Cells(Ligne, 7).Value = Target.Value
End With
Application.EnableEvents = True
End Sub
Bonjour Thèze,
Un tout grand merci pour ta réponse, mais je n'arrive malheureusement pas à adapter tes codes à mon fichier, car le système d'identification est basé sur une comparaison du Login et du mot de passe des utilisateurs.
Ci-joint le fichier un peu allégé pour que tu visualises mieux (Login : Admin, mot de passe : Admin).
Comme tu pourras le constater, dans la feuille "Param" sont renseignés les logins et mdp pour permettre l'identification des utilisateurs, et selon leurs droits, afficher certaines feuilles et cacher les autres.
Sans trop abusé de ton temps, je serais ravi si tu pouvais essayer d'adapter tes codes directement dans ce fichier, parce que j'avoue que je me sens un peu perdu là
EDIT : J'ai finalement utilisé et adapté uniquement ton code à placer dans le module du classeur, cela me convient parfaitement
Merci encore pour ton aide !
Bonjour Theze, le forum,
Après utilisation j'aimerais savoir s'il serait possible d'avoir ce petit bonus :
Récupérer la valeur de la cellule AVANT sa modification ?
Il me semble qu'on ne peut pas par Workbook_SheetChange et qu'il faut passer par Workbook_SelectionChange non ?
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Ligne As Long
If Sh.Name = "Log" Then Exit Sub
Application.EnableEvents = False
With Worksheets("Log")
.Cells(1, 1).Value = "Utilisateur"
.Cells(1, 2).Value = "Date"
.Cells(1, 3).Value = "Heure"
.Cells(1, 4).Value = "Feuille"
.Cells(1, 5).Value = "Cellule"
.Cells(1, 6).Value = "Ancienne valeur"
.Cells(1, 7).Value = "Nouvelle valeur"
Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, 1).Value = UserForm2.TextBox1.Value
.Cells(Ligne, 2).Value = Format(Date, "dd/mm/yyyy")
.Cells(Ligne, 3).Value = Format(Time, "hh:mm:ss")
.Cells(Ligne, 4).Value = Sh.Name
.Cells(Ligne, 5).Value = Target.Address(0, 0)
.Cells(Ligne, 6).Value = Target.Value 'avant modification
.Cells(Ligne, 7).Value = Target.Value
End With
Application.EnableEvents = True
End Sub
Bonjour,
Il faut faire une recherche sur l'adresse de la cellule dans la colonne E de la feuille "Log" en partant du bas et la première trouvée sera forcément la dernière valeur entrée :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Cel As Range
Dim Ligne As Long
Dim Valeur As String
If Sh.Name = "Log" Then Exit Sub
Application.EnableEvents = False
With Worksheets("Log")
.Cells(1, 1).Value = "Utilisateur"
.Cells(1, 2).Value = "Date"
.Cells(1, 3).Value = "Heure"
.Cells(1, 4).Value = "Feuille"
.Cells(1, 5).Value = "Cellule"
.Cells(1, 6).Value = "Ancienne valeur"
.Cells(1, 7).Value = "Nouvelle valeur"
Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'la recherche est faite sur la 5ème colonne (E) en partant du bas et en remontant
'Offset(1) pour prendre en compte la dernière cellule non vide car sinon, se sera l'avant dernière valeur qui sera retournée
Set Cel = .Columns(5).Find(Target.Address(0, 0), .Cells(.Rows.Count, 5).End(xlUp).Offset(1), xlValues, xlWhole, , xlPrevious)
If Not Cel Is Nothing Then Valeur = Cel.Offset(, 2).Value Else Valeur = ""
.Cells(Ligne, 1).Value = UserForm2.TextBox1.Value
.Cells(Ligne, 2).Value = Format(Date, "dd/mm/yyyy")
.Cells(Ligne, 3).Value = Format(Time, "hh:mm:ss")
.Cells(Ligne, 4).Value = Sh.Name
.Cells(Ligne, 5).Value = Target.Address(0, 0)
.Cells(Ligne, 6).Value = Valeur
.Cells(Ligne, 7).Value = Target.Value
End With
Application.EnableEvents = True
End Sub
Bonjour Theze,
C'est parfait, merci beaucoup pour ton aide !
Bonne journée et bon WE