XL 2016 Boite de dialogue windows

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

bernardrustrel

XLDnaute Occasionnel
Bonjour.
J'aimerais savoir si il existe une possibilité de choisir un fichier quelconque et ensuite en ouvrir la boite de dialogue "windows" de ses propriétés. Tout ça avec VBA
Merci à vous de bien vouloir orienter ma réflexion sur le sujet.
Cordialement
 
Bonjour,
voir si cela correspond à votre demande.
VB:
Sub Rectangleàcoinsarrondis3_Cliquer()
infosClasseurBuiltinDocumentProperties
End Sub

Sub infosClasseurBuiltinDocumentProperties()
Dim Valeur As DocumentProperty
Dim R As Byte
 
On Error Resume Next

' Pour afficher directement dans le classeur
R = 1
For Each Valeur In ActiveWorkbook.BuiltinDocumentProperties
    Cells(R, 1) = Valeur.Name
    Cells(R, 2) = Valeur.Value
    R = R + 1
Next

'Pour afficher dans msgBox (liste à compléter ou à modifier suivant besoin)
MsgBox ActiveWorkbook.BuiltinDocumentProperties("Title").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Subject").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Author").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Keywords").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Comments").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Template").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Last Author").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Revision Number").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Creation Date").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Last Save Time").Value & vbCrLf & _
ActiveWorkbook.BuiltinDocumentProperties("Security").Value
End Sub
 

Pièces jointes

Bonjour,
Une solution s'y rapprochant fortement, voir commentaire sur feuille 2
Nota: Nécessite d'activer la référence Microsoft Shell Controls and Automation

VB:
Dim sChemin As String
Dim sFich As String
    sChemin = ThisWorkbook.Path & "\"
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = sChemin
        .Title = "Sélectionner le fichier"
        .AllowMultiSelect = False
        .ButtonName = "Sélection Fichier"
        With .Filters
            .Clear
            .Add "All", "*.*"
        End With
        .Show
        If .SelectedItems.Count > 0 Then
            sFichier = .SelectedItems(1)
            
            sFich = sFichier
            ListeProprietesFichier_getDetailsOf sFich
        End If
    End With
End Sub


Sub ListeProprietesFichier_getDetailsOf(Fichier As String)
    'source:
    'http://www.microsoft.com/resources/documentation/windows/2000/server/
    'scriptguide/en-us/sas_fil_lunl.mspx
    '
    'Nécessite d'activer la référence Microsoft Shell Controls and Automation
    '
    Dim Fso As Object, oFichier As Object
    Dim objShell As Shell32.Shell
    Dim objFolder As Shell32.Folder
    Dim strFileName As Shell32.FolderItem
    Dim Chemin As String, NomFich As String, Resultat As String
    Dim i As Byte
    
    '-----
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set oFichier = Fso.GetFile(Fichier)
    Chemin = Fso.GetParentFolderName(oFichier)
    NomFich = Fso.GetFileName(oFichier)
    '-----
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Chemin)
    Set strFileName = objFolder.Items.Item(NomFich)
    
    For i = 0 To 34
        'Cet exemple n'affiche pas les propriétés vides
        If objFolder.GetDetailsOf(strFileName, i) <> "" Then _
        Resultat = Resultat & objFolder.GetDetailsOf(objFolder.Items, i) _
        & ":  " & objFolder.GetDetailsOf(strFileName, i) & vbLf
    Next
    
    MsgBox Resultat
End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
334
Réponses
20
Affichages
1 K
Réponses
21
Affichages
2 K
Retour