XL 2021 VBA - Retrouver le Caption d'un objet intégré (embbeded object)

[Dudu2]

Bonjour,

Je n'arrive pas à trouver une propriété de Shape ou d'OLEObject qui me rendrait le nom qui apparait sous l'icône et qui correspond au nom du fichier qui été inséré en tant qu'objet: Insertion / Texte / Objet / Créer à partir du fichier (pas de case cochée).

 

[sylvanu]

Bonjour Dudu,
Juste pour essayer d'avancer.

Sub Macro1()
    ActiveSheet.Shapes("Object 1").Select
    Selection.Verb Verb:=33
End Sub

Cette macro ouvre les propriétés de l'objet. Le nom figure dans la feuille Détails sous Nom . On trouve bien PDF.ico.
Par contre je ne sais pas accéder à cette propriété par VBA. 😢

 

[Dudu2]

Merci @sylvanu,
C'est déjà beaucoup mieux que rien.

 

[Lolote83]

Bonjour,
J'obtiens une erreur avec le code donné par @sylvanu

@+ Lolote83

 

[sylvanu]

Re,
Avec XL2007 et VBA6.3, j'obtiens ça.

 

[nullosse]

Salut,
le matou qui proute m'a proposé un tas de solution, mais il a fini par arrivé à la conclusion que c'est impossible à faire en vba.
Comme on voit ce nom dans les propriétés Objet de l'objet , il faudrait pouvoir ouvrir cette fenêtre en vba et peut-être qu'avec uiautomation on pourrait aller picorer le nom de fichier dans la fenêtre.

avec ce code j'arrive à ouvrir une fenêtre sur l'objet , c'est pas la bonne mais dedans il y a le nom du fichier :

Sub Macro1()
    ActiveSheet.Shapes("Object 1").Select
    Selection.Verb Verb:=2    'xlVerbProperties
End Sub

 

[Dudu2]

@nullosse,
Effectivement, on doit pouvoir le récupérer avec des Sendkeys (Tab / Tab / Tab / Ctr+C / ESC).
Mais par VBA directement, je n'ai rien trouvé sur les forums qui permette de le faire.

Merci à tous les 2.

 

[Dudu2]

Et la petite fonction qui va bien (chez moi en tous cas)

'----------------------------------------
'Get the Caption of an Embbeded OLEObject
'----------------------------------------
Private Function GetEmbbededOLEObjectCaption(Shape As Shape) As String
    Dim ActiveSheetAtCallTime As Worksheet
    Dim ScreenUpdatingAtCallTime As Boolean
    Dim DataObject As Object
    '
    Const xlVerbProperties = 2
 
    'Initialisations
    ScreenUpdatingAtCallTime = Application.ScreenUpdating
    Set ActiveSheetAtCallTime = ActiveSheet
 
    Application.ScreenUpdating = False
    Shape.Parent.Activate
    Shape.Select
    CreateObject("wscript.shell").SendKeys "{TAB}{TAB}{TAB}^c{ESC}"
    Selection.Verb Verb:=xlVerbProperties
    DoEvents
    ActiveCell.Select
 
    Set DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    With DataObject
        .GetFromClipBoard
        'Return value
        GetEmbbededOLEObjectCaption = .GetText
    End With
 
    'Terminaisons
    ActiveSheetAtCallTime.Activate
    Application.ScreenUpdating = ScreenUpdatingAtCallTime
End Function

 

[patricktoulon]

bonsoir
par vba
filecopy original , fichier.zip
ouvrir le zip avec createobject("shell.application")
récupérer le .bin qui est dans le dossier embedding dans l'archive
ouvrir le .bin avec open for input.....
chercher le chemin complet dans l'utilisation temporaire (le apdatata) il n'est cité qu'une fois je crois

voila
Patrick

 

[Dudu2]

Bonsoir @patricktoulon,

Certes en VBA mais via fichier.
Alors via fichier il y a aussi la solution qui consiste à enregistrer l'OLEObject Embbeded temporairement.

Private Function GetEmbbededOLEObjectCaption2(Shape As Shape) As String
    Dim oShell As Object
    Dim FolderName As String
    Dim FileName As String
    '
    Const TempFolderName = "TempFolder"

    FolderName = Environ("TEMP") & "\" & TempFolderName
    MkDir FolderName
    
    Set oShell = CreateObject("Shell.Application")
    
    'Save the Embbeded Object
    Shape.OLEFormat.Object.Copy
    oShell.Namespace(Environ("TEMP") & "\" & TempFolderName).Self.InvokeVerb "Paste"

    'Get the first file from the folder
    FileName = Dir(FolderName & "\", vbNormal)
    Kill FolderName & "\" & FileName
    RmDir FolderName
     
    'Return value
    GetEmbbededOLEObjectCaption2 = FileName
End Function