Discussion :

[cha_choux]

Bonjour,

A partir du code de SilkyRoad (http://silkyroad.developpez.com/VBA/...etesClasseurs/), j'ai pu récupérer certaine information d'un PWP en lecture seule via mon Excel.

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
    Sub proprietesFichier_getFile(Fichier As String)
        '
        'Nécessite d'activer la référence Microsoft Scripting Runtime
        '
        Dim Cible As Scripting.FileSystemObject
        Dim Valeur As Scripting.File
        Dim Resultat As String
 
        Set Cible = CreateObject("Scripting.fileSystemObject" )
        Set Valeur = Cible.GetFile(Fichier)
 
        Resultat = "Chemin et nom complet : " & Cible.GetAbsolutePathName(Valeur) & Chr(10) & Chr(10) & _
        "Nom fichier : " & Cible.GetFileName(Valeur) & Chr(10) & Chr(10)
 
        MsgBox Resultat
    End Sub

Quelqu'un sait comment récupérer le nom de la personne utilisant actuellement le PWP ?

Merci pour votre aide !
Bonne journée

[riaolle]

Bonjour,

je sais que

Code :

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

Environ("USERNAME")

permet de connaitre le nom de la personne en train d'utiliser un fichier, mais je ne sais pas trop comment spécifier le fichier. En tout cas, tu peux cessayer de chercher de ce côté-là

[joe.levrai]

Bonjour,

ce qui semble être un exemple appliqué pour un fichier Excel, trouvé chez nos amis anglophones
l'auteur est signé en en-tête

reste à retoucher le code pour qu'il s'applique à ton fichier powerpoint ?

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
'=======================================================================================
'- ACCESS A .XLS FILE TO GET LAST USER NAME
'- CAN ALSO BE USED IF THE FILE IS IN USE
'- NB. This code works in XL97 and XL2000 - don't know about others
'=======================================================================================
'- NB.1.Cannot get this by *opening* the workbook because we then become the last user.
'-    2.Not the same as the "Last saved by" property which requires opening the workbook.
'-    3.No security. A user can change their name temporarily in Tools/Options.
'=======================================================================================
'- Last user name is preceded by characters [\][0][p][0][??][0][0]
'- [??] is a variable character - its code shows the number of characters in the name.
'- followed by any number of spaces (and can include spaces)
'- Method : Use a Regular Expression to find the precedes + 50 following characters
'-          ..... then use the [??] character to extract the string
'- Brian Baulsom December 2007
'========================================================================================
Sub GetLastUser()
    Dim MyFile As String            ' File name
    Dim MyRegExp As Object
    Dim MyLastUser                  ' last user name
    Dim LastUserLen As Integer      ' character 5 name length
    Dim FileString As String        ' file converted to a string in memory
    Dim MyMatches As Variant        ' RegExp array of matches (should only be 1)
    Dim MyLastSaved As String       ' "Last saved by" from properties
    '---------------------------------------------------------------------------------
    ChDrive "F:\"
    ChDir "F:\"
    MyFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
    If MyFile = "False" Then End
    '----------------------------------------------------------------------------------
    '- PUT THE FILE INTO MEMORY AND CLOSE IT
    Open MyFile For Binary Access Read Shared As #1
        FileString = Space(LOF(1))
        Get 1, 1, FileString
    Close #1
    '----------------------------------------------------------------------------------
    '- SET UP A REGULAR EXPRESSION
    Set MyRegExp = CreateObject("VbScript.RegExp")
    With MyRegExp
        .Global = True
        .Pattern = "\\\x00p\x00.\x00\x00.{50}"      ' 57 characters should be enough
        Set MyMatches = .Execute(FileString)        ' zero based array
        '------------------------------------------------------------------------------
        '- DISPLAY RESULTS (should only be 1 match = Matches(0))
        '------------------------------------------------------------------------------
        '- check only 1
        If MyMatches.Count <> 1 Then
            MsgBox ("Found " & MyMatches.Count & " matches" & vbCr _
                    & "Only showing first one.")
        End If
        '------------------------------------------------------------------------------
        '- exclude first 7 characters & trailing spaces
        MyLastUser = MyMatches(0)                       ' 57 characters found
        LastUserLen = Asc(Mid(MyLastUser, 5, 1))        ' length of name
        MyLastUser = Mid(MyLastUser, 8, LastUserLen)    ' extract name
        '------------------------------------------------------------------------------
        '- Message
        rsp = MsgBox(MyFile & vbCr & "Last user : " & MyLastUser)
        '--------------------------------------------------------------------------------
        FileString = ""
    End With
    '------------------------------------------------------------------------------------
End Sub
'========================================================================================

[cha_choux]

Bonjour,

Merci à vous deux !
Je teste et je reviens vers vous

PS : le code est exécuté par Excel (je ne sais pas si j'étais très clair dans mon post)

[cha_choux]

Re

Je viens d'essayer

Code :

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

1
2
    NomUtilisateur = Environ("username")
                    MsgBox NomUtilisateur

Ca fonctionne merci beaucoup !!!

Joe ton code avait une erreur du coup je n'ai pas pu le mettre en place

[cha_choux]

Pour info Voici le résultat obtenu

[clementmarcotte]

Re

Joe ton code avait une erreur du coup je n'ai pas pu le mettre en place

M'est avis que le code n'est probablement pas transposable directement à PowerPoint.

Ceci dit, un code de ce genre qui fonctionne sur un fichier xls, ne fonctionnera probablement pas avec un fichier Excel à 4 lettres. (2007 et suivants)

Avec Office 2007, Microsoft est passé des formats binaires propriétaires, aux formats Open XML. Ce sont en fait des conteneurs au format zip. Les textes et les données sont tous dans des fichiers XML (de vulgaires fichiers texte écrits dans une "disposition spéciale". Les seules chose au format binaire sont les macros, les images ou les vidéos.

[cha_choux]

Bonjour Clement,

Je n'avais pas vu ta réponse.
J'ai finalement eu des problèmes puisque ce que je récupérais étais le login windows et non celui de la personne utilisant le PWP

Voici le nouveau post que j'ai ouvert : https://www.developpez.net/forums/d1...n/#post9137458