Salut Baroude et Patrick
Directement par une macro, non je ne sais pas faire... Et surtout je ne pense pas que celà soit possible à ma connaissance. (celà m'aurait grandement simplifié la vie !!!)
En ce qui concerne Application.Username, oui ça retourne ce qui a été enregistré par l'utilisateur dans Menu => Option => Onglet Général... (donc pas fiable le User Peut Changer son ID)... Et çà ne peut être lu qu'en local, pas à distance.
Mais il y des astuces que j'utilise pour contourner ce problème.
En voici une qui me permet même de savoir le temps d'utilisation du fichier en plus du UserName :
Conditions :
Les Fichiers partagés ne sont ouverts qu'avec une Interface User : "CommandBoard.xls" ou un "Personnal.xls" dans le XLStart qui contient les macros nécessaires... (Mes Users ne savent même pas où se trouvent les fichiers partagés, on peut même les protéger à l'ouverture par passworld qui ne serait connu que par la macro pour éviter tout risque..)
Donc à l'ouverture de ce classeur CommandBoard.xls on peut faire écrire le nom du user...
Pour avoir le nom du User (le vrai celui du log-in en réseau) il faut utiliser cette API API (Application Programming Interface ) livrée en standard avec Sample.xls, qui quant à elle garantie de retourner le Log-in Name du User Connecté en Réseau.
Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Sub Get_User_Name()
Dim lpBuff As String * 25
Dim ret As Long, UserName As String
ret = GetUserName(lpBuff, 25)
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
Sheets("Interface").Range("F6").Value = UserName
End Sub
Exemple :
Le ClasseurCommandBoard = Contient l'API ci dessus et le(s) bouton(s) d'ouverture des classeurs partagés avec la macro ci dessous...
Le ClasseurX.xls = Ce fameux fichier que l'on doit utiliser à plusieurs
Le UserTracker.xls = Un fichier de Registre dans le réseau.
Procédure :
Dans le CommandBoard.xls la macro qui ouvre le fichier partagé
va ouvrir le UserTracker et écrire le nom du User en cours (en utilisant "Get_User_Name"... dans la même macro tu sauves et tu fermes UserTracker...
Le Code
Option Explicit
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function
Sub CallDemands()
UserFormBanksDemands.Show
End Sub
Sub CallDemand()
Dim User As String
Dim Temps As String
Application.ScreenUpdating = False
If IsFileOpen("I:\Commun Tools\ClasseurX.xls") Then
Workbooks.Open "I:\Commun Tools\UserTrackers.xls"
User = Sheets("Program").Range("B2")
Temps = Sheets("Program").Range("D2")
Workbooks("UserTrackers.xls").Close False
MsgBox "ClasseurX Program is already in use !" & _
Chr(13) & Chr(10) & "By " & User & _
Chr(13) & Chr(10) & "Since " & Format(Temps, "HH:MM") & _
Chr(13) & Chr(10) & _
Chr(13) & Chr(10) & " Please Try latter" & _
Chr(13) & Chr(10) & _
Chr(13) & Chr(10) & "Thank You 🙂", _
vbOKOnly + vbCritical, "PROGRAM NOT AVAILABLE"
Else
Workbooks.Open "I:\Commun Tools\ClasseurX.xls"
Workbooks.Open "I:\Commun Tools\UserTrackers.xls"
With Sheets("Program")
.Range("B2") = Workbooks("CommandBoard.xls").Sheets("Interface").Range("F6")
.Range("C2") = Format(Now, "DD/MM/YY")
.Range("D2") = Format(Now, "HH:MM:SS")
End With
Workbooks("UserTrackers.xls").Close True
End If
Application.ScreenUpdating = True
End Sub
Pour la petite histoire, ceci et l'aboutissement d'un travail commun que j'ai fait avec l'aide de Frédérique Sigonneau, Thierry Rural et El-Joker du MPFE... (voir le début de cette astuce sur Disciplus : http://disciplus.simplex.free.fr/xl/repertoires.htm#partagéouvert )
En espérant que celà puisse t'orienter vers une solution...
Bonne Fin de Journée
@+Thierry
