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…
Bonjour,
RépondreSupprimerJe 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
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é :)
RépondreSupprimerIl ne reste plus qu'à relier cela à la base des adresses IP de l'entreprise pour identifier l'auteur des modifications.
Merci pour cette suggestion !