Discussion :

[cha_choux]

Bonjour le forum

J'ai créé un programme Excel permettant d'effectuer la MAJ d'un PWP en fonction de feuilles Excel.
Le truc c'est que si le PWP est déjà utilisé par un utilisateur j'aimerais connaître son nom afin de pouvoir l'appeler pour fermer ledit PWP.

J'ai essayé d'utiliser

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NomUtilisateur = .Environ("username")

Mais ce dernier me retourne le login Windows et non le login du fichier PWP
Je ne peux pas utiliser de .dll car nous avons dans l'entreprise des PC sous XP en 32 bits, des Seven en 32 bits, mais aussi des Seven et Windows 10 en 64 bits

Voici le code en ce moment :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    Dim pptapp As Object
    Set pptapp = CreateObject("powerpoint.application")
    Dim oPPTApp As PowerPoint.Application
    Set oPPTApp = New PowerPoint.Application
 
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
 
    '=======> Vérifie les erreurs
    Select Case errnum
 
        '=======> Aucune erreur : le fichier n'est pas ouvert par un autre utilisateur <========
        Case 0
         IsFileOpen = False
         With oPPTApp
            .Visible = True
            .Presentations.Open ("S:\DSI France - PMO\FLASH_REPORT\FLASH_REPORT.pptm")
            .Run ("FLASH_REPORT.pptm!FLASH_REPORT")
        End With
 
        '=======> Permission refusée : le fichier est ouvert par un autre utilisateur <========
        Case 70
            IsFileOpen = True
            With oPPTApp
                proprietesFichier_getFile "S:\DSI France - PMO\FLASH_REPORT\FLASH_REPORT.pptm"
            End With
 
        '=======> Aucune erreur
        Case Else
            Error errnum
    End Select
End Function
 
Sub proprietesFichier_getFile(Fichier As String)
    '=======> /!\ Nécessite d'activer la référence Microsoft Scripting Runtime /!\ <========
    '=======> http://silkyroad.developpez.com/VBA/ProprietesClasseurs/ <========
    Dim Cible As Scripting.FileSystemObject
    Dim Valeur As Scripting.File
    Dim Resultat As String
 
    LoginPC = Environ("username")
 
 
    Set Cible = CreateObject("Scripting.fileSystemObject")
    Set Valeur = Cible.GetFile(Fichier)
 
    Resultat = Cible.GetAbsolutePathName(Valeur)
    NomUtilisateur = VBA.Environ("username")
    'NomUtilisateur = Application.UserName
 
 
    If LoginPC = NomUtilisateur Then
         With oPPTApp
            .Visible = True
            .Run ("FLASH_REPORT.pptm!FLASH_REPORT")
        End With
    Else
        MsgBox "Le fichier " & Resultat & " est déjà ouvert par l'utilisateur " & NomUtilisateur & ". Veuillez vous assurer de sa fermeture afin d'effectuer la mise à jour."
    End If
End Sub

Avez vous une idée de fonction ?
Cordialement

[Menhir]

Je ne suis pas sûr que ce soit possible.

Ce n'est pas un paramètre de l'Application puisqu'il s'agit de l'utilisateur d'une autre poste (donc d'une autre cession de l'application).
Ce n'est pas un paramètre du Workbook (ou Presentation pour PWP) puisqu'il s'agit d'un autre utilisateur.
Même chose pour la cession Windows.

C'est un paramètre lié au fichier lui-même, en tant qu'élément du File System.

Et je ne vois pas de propriété de File en VBA qui puisse donner cette information.

Tu peux essayer de faire des tests avec ça : https://msdn.microsoft.com/fr-fr/lib.../ff193788.aspx

[cha_choux]

Merci pour ta réponse!

Au moins je ne perds pas du temps à chercher quelque chose qui te parais impossible

Je vais tester ton lien et je reviens vers toi
C'est ce que j'essayai justement mais il me retournait les paramètres Excel (ce qui est logique vis à vis du code)
Tu sais ce que je peux mettre à la place de ThisWorkBook.UserStatus ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 IsFileOpen = True
            With oPPTApp
               Dim Users, Msg As String, Status As String, i As Integer
               Users = ThisWorkbook.UserStatus
               For i = 1 To UBound(Users, 1)
               Msg = Msg & Users(i, 1) & " " & Format(Users(i, 2), "dd/mm/yy h:mm") & " "
               If Users(i, 3) = 1 Then Status = "(Exclusive mode)" Else Status = "(Shared mode)"
               Msg = Msg & Status & vbLf
               Next
               MsgBox Msg, 64
            End With