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

Rechercher des sujets similaires à "adaptation code tracabilite"