Monsieur Excel
Pour tout savoir faire sur Excel !

02 mai 2009

Voulez-vous jouer à Big Brother ?

Vous souhaitez, pour un fichier partagé par plusieurs collaborateurs, savoir qui a effectué des modifications, et à quelle date.

Vous ne désirez pas obtenir tout le détail des modifications, que l’on pourrait obtenir en activant la commande « Suivi des modifications », comme nous l’avons vu dans les messages du 20 et du 24 avril. Vous souhaitez seulement connaître le nom de chaque personne qui a modifié le classeur, avec la date et l’heure de l’opération.

Nous avons reproduit ci-dessus le code de la macro qu’il faut associer au classeur pour enregistrer – au moment de la sauvegarde du classeur – le nom de l’utilisateur, la date et l’heure, ainsi que le résultat obtenu dans la feuille « Espion ».

Remarque 1 – Il ne reste plus qu’à masquer la feuille « Espion » et à protéger le code VBA par un mot de passe pour que tout cela se passe à l’insu d'un utilisateur lambda.

Remarque 2 – Bien entendu, si l’utilisateur modifie son nom ou l’horloge de sa machine avant la sauvegarde, les informations enregistrées seront fausses…

rédigé par Hervé Thiriez | 2 commentaire(s)

2 Commentaire(s):

  • Bonjour,
    Je suis un lecteur de certains de vos livres depuis plus de vingt ans et fidèle lecteur de votre Blog également.
    Pour "Piste" les utilisateurs, je pense plus fiable de relever l'adresse IP du poste car c'est bien connu, les noms d'utilisateur dans MS Office sont souvent mal ou pas renseignés.
    Je fais suivre la macro nécessaire (récupéré sur le net) :
    Private Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
    Private Declare Function WSACleanup Lib "wsock32" () As Long
    Private Declare Function gethostname Lib "wsock32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
    Private Declare Function gethostbyname Lib "wsock32" (ByVal HostName As String) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nBytes As Long)
    Private Const MAX_WSADescription As Long = 256
    Private Const MAX_WSASYSStatus As Long = 128
    Private Const WS_VERSION_REQD As Long = &H101
    Private Const IP_SUCCESS As Long = 0
    Private Const SOCKET_ERROR As Long = -1
    Private Const NO_ERROR = 0
    Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
    End Type
    Public Type Hostent
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
    End Type



    ' Renvoie l'adresse IP
    Public Function GetIPAddress() As String
    Dim sHostName As String * 256
    Dim lpHost As Long
    Dim HOST As Hostent
    Dim dwIPAddr As Long
    Dim tmpIPAddr() As Byte
    Dim i As Integer
    Dim sIPAddr As String

    If Not SocketsInitialize() Then
    GetIPAddress = ""
    Exit Function
    End If
    ' Si GetHostName ne marche pas
    If gethostname(sHostName, 256) = SOCKET_ERROR Then
    GetIPAddress = ""
    Call SocketsCleanup
    Exit Function
    End If
    sHostName = Trim$(sHostName)
    lpHost = gethostbyname(sHostName)
    ' Si l'adresse récupérée est vide
    If lpHost = 0 Then
    GetIPAddress = ""
    Call SocketsCleanup
    Exit Function
    End If
    ' On formate l'adresse pour qu'elle soit de la forme xxx.xxx.xxx.xxx
    CopyMemory HOST, ByVal lpHost, Len(HOST)
    CopyMemory dwIPAddr, ByVal HOST.hAddrList, 4
    ReDim tmpIPAddr(1 To HOST.hLen)
    CopyMemory tmpIPAddr(1), ByVal dwIPAddr, HOST.hLen
    For i = 1 To HOST.hLen
    sIPAddr = sIPAddr & tmpIPAddr(i) & "."
    Next
    ' On renvoie la valeur
    GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
    Call SocketsCleanup
    End Function

    ' Vide le socket
    Public Function SocketsCleanup()
    SocketsCleanup = IIf(WSACleanup() = 0, True, False)
    End Function

    ' Initialise le socket
    Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSADATA
    SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
    End Function

    Sub ShowIP()
    MsgBox GetIPAddress
    End Sub

    Rémy VASSARD

    By Blogger MacEnthousiast, sur 12:05 PM  

  • Certes, le code que vous proposez donne bien l'adresse IP au prix, il est vrai, d'un nombre d'instructions légèrement plus élevé :)

    Il ne reste plus qu'à relier cela à la base des adresses IP de l'entreprise pour identifier l'auteur des modifications.

    Merci pour cette suggestion !

    By Blogger Hervé Thiriez, sur 10:34 AM  

Enregistrer un commentaire

<< Accueil