XL 2021 VBA - Enregistrer en fichier un Embbeded PDF créé en présence d'Adobe Acrobat sur le PC

  • Initiateur de la discussion Initiateur de la discussion Dudu2
  • Date de début Date de début

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 !

Dudu2

XLDnaute Barbatruc
Bonjour,

Je n'utilise généralement pas Adobe Acrobat pour visualiser les PDF, lui préférant PDF-XChange Viewer plus léger et moins invasif.
Cependant l'ayant installé, il créé de nombreux problèmes avec les PDF intégrés (embbeded).

Ce logiciel intrusif modifie les propriétés du PDF embbeded et rend impossible l'ouverture par un autre logiciel qu'Acrobat alors que sous PDF-XChange Viewer, le PDF embbeded peut être ouvert par n'importe quel PDF Viewer.
De plus il faut désactiver le "Mode protégé au démarrage" (Acrobat / Menu / Préférence / Protection (renforcée) / Décocher "Activer le mode protégé au démarrage") pour visualiser les PDF embbeded.

Si j'arrive sans problème à enregistrer en fichier un PDF qui a été intégré (embbeded) en l'absence d'Adobe Acrobat sur le PC (seulement PDF-XChange Viewer), je n'y arrive pas lorsque le PDF a été intégré (embbeded) en présence d'Adobe Acrobat sur le PC.

La question: comment enregistrer en fichier un PDF qui a été intégré (embbeded) en présence d'Adobe Acrobat sur le PC ? (Voir le fichier joint).
Ou alors comment modifier les propriétés du PDF embbeded pour qu'il soit ouvrable par n'importe quel PDF Viewer ?

Justification: en enregistrant en fichier le PDF intégré en présence d'Acrobat, on pourrait alors le lancer quelque soit le PDF Viewer installé.
 

Pièces jointes

Dernière édition:
Solution
pas besoin de renommer il faut en fait explorer le fichier qui est ouvert pour extraire les .bin qui correspondent aux PDF intégrés . Ces .bin ils contiennent les PDF mais il faut "décapsuler" les PDF des .bin qui sont en OLE.
Pour la deuxième question c'est bizarre j'ai mis ton message intégral.
Je viens d'essayer de "décapsuler" les 2 .bin qui sont dans ton classeur avec Notepad++. Ben apparemment il suffit de chercher la chaine %PDF et de supprimer tout ce qu'il y a avant. En donnant des extensions .pdf alors à ces fichiers , j'arrive à les lire sans problème avec un lecteur PDF.
Voici du code VBA généré par I.A (j'ai seulement suggéré à l'I.A d'utiliser le tar windows et de supprimer ce qu'il y a avant %PDF ) qui :
1 -...
Bonjour,

Avec les embbeded standard, on retrouve un nom de fichier après l'%%EOF dans le .oleObjectx.bin pour le relier à l'un des embbeded objects.
Le problème avec Acrobat, c'est qu'il n'y a aucune information dans le .oleObjectx.bin pour rappeler le nom de fichier (l'embbeded du fichier posté n'est pas représentatif car il vient d'un Word et ça permet de voir le nom de fichier).

D'ailleurs, à l'affichage avec Acrobat pour embbeded standard il affiche bien le nom de fichier mais pour un embbeded Acrobat il n'affiche que "Document Acrobat". C'est de l'Adaube.

Donc ce système n'est pas utilisable car même si on sait récupérer des PDF on ne sait pas à quel embbeded (Acrobat) ils appartiennent.

Pour m'en sortir j'ai dû applique le système décrit en Post #10.

Edit: pour info, la création du fichier ZIP ne fonctionne pas correctement pour un fichier en mode compatibilité .xls.

Edit 2: Pour être sûr du PDF qu'on récupère il faudrait partir de la sélection de l'embbede object par l'utilisateur, le copier dans un nouveau Workbook et récupérer cet unique PDF obtenu à partir du BIN. Et de là, l'afficher en tant que fichier.
 
Dernière édition:
comme je t'ai dis pour connaitre le nom des pdf il te suffit de l'ouvrir avec open for classiquement comme si c'etait un texte
tu cherche la ligne ou apparait apdata et bien cette ligne commence par le nom du fichier

pour celui d'adaube ben la mon ami c'est copieux moi j'ai rien trouvé

faut voir si une copie entière de l'embed en fichier en parallèle pourrait t'en donner plus

pour les pdf normal pas adaube lu dans le bin directement
demo4.gif
 
Dernière édition:
Avec le système alternatif décrit en Post #10 je m'en sors mais c'est un peu bidouille.

Je vais rebasculer un stockage des PDF embbeded tels qu'ils sont avec Acrobat.

Pour un possesseur d'Acrobat, il pourra l'afficher soit en double clic sur l'Embbeded Object soit par lancement vba (bouton, double-clic en cellule et Shape.OLEFormat.Verb xlPrimary), à la protection renforcée près, mais c'est un simple setting.

Pour un non possesseur d'Acrobat il ne pourra l'afficher que par lancement vba (bouton, double-clic en cellule et Shape.OLEFormat.Verb xlPrimary). Le Verb va panter en erreur 1004 et à partir de là on peut passer à la copie sur un nouveau Workbook temporaire, récupération du fichier par l'un de vos codes, puis affichage du fichier.
 
tu l'avais dans mon taskpane project en plus

je te redonne le code de extraction + la fonction Getapppdfdefaut et ala fin de l'extraction je te les ouvre dans l'application par defaut

la petite fonction magique
VB:
Public Type PdfAppInfo: FullPath As String: ExeName As String: End Type
Public Function GetPdfDefaultExe() As PdfAppInfo
    'patricktoulon
    Dim WsH As Object, progId$, cmd$
    Dim info As PdfAppInfo, str$
    Set WsH = CreateObject("WScript.Shell")
    progId = WsH.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.pdf\UserChoice\ProgId")
    cmd = WsH.RegRead("HKCR\" & progId & "\shell\open\command\")
    If InStr(cmd, """") > 0 Then
        str = Split(Mid(cmd, 2), """")(0)
    Else
        str = cmd
    End If
    If cmd = "" Then MsgBox "l 'application n'a pas pu determiner l'application par défaut pour les pdfs":
    info.FullPath = str
    info.ExeName = str
    GetPdfDefaultExe = info
End Function

l'extraction on change rien sauf le kill des existants (au cas ou) et la suppression se fait sous condition <>".pdf"
je les ouvre directe dans l'app par defaut
Code:
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Sub ExtrairePDFDepuisBinEtNettoyer()
    Dim col As New Collection
    Dim WsH As Object, dossierEmbeddings As Object, items As Object, item As Object, stream As Object
    Dim tempo$, chemin$, binPath$, pdfPath$, bytes() As Byte, pdfBytes() As Byte, i&, startPos&, endPos&
    Dim appdefaut As PdfAppInfo
    tempo = ThisWorkbook.Path & "\tempo.zip" 'chemin du zip
    ThisWorkbook.SaveCopyAs tempo 'on sauve une copie temporaire du classeur au format zip directement
    Application.Wait Now + TimeValue("0:00:01")
    col.Add tempo ' le premier item ce sera le zip complet
    
    Set WsH = CreateObject("Shell.Application") 'c'rée l'object shel application
    Set dossierEmbeddings = WsH.Namespace(tempo & "\xl\embeddings") 'le path complet du dossier dans le zip du dossier embbedding
    If dossierEmbeddings Is Nothing Then MsgBox "Pas de dossier xl\embeddings": Exit Sub 'on se casse si y a pas
    
    Set items = dossierEmbeddings.items 'collection des items a l'inteieurs du dossier
    For Each item In items
        If Dir(ThisWorkbook.Path & "\" & item.Name) <> "" Then Kill ThisWorkbook.Path & "\" & item.Name
        WsH.Namespace(ThisWorkbook.Path).CopyHere item, 4 'on extrait
        col.Add ThisWorkbook.Path & "\" & item.Name 'on ajoute les path a la collection
    Next item
    DoEvents
    Set WsH = Nothing
    
    ' Étape 2 : Extraction PDF
    For i = 2 To col.Count
        binPath = col(i)
        pdfPath = Replace(binPath, ".bin", ".pdf")
        col.Add pdfPath
        If Dir(pdfPath) <> "" Then Kill pdfPath
        Set stream = CreateObject("ADODB.Stream")
        stream.Type = 1
        stream.Open
        stream.LoadFromFile binPath
        bytes = stream.Read
        stream.Close
        
        ' Chercher %PDF le debut
        startPos = -1
        For j = 0 To UBound(bytes) - 3
            If Chr(bytes(j)) = "%" And Chr(bytes(j + 1)) = "P" And Chr(bytes(j + 2)) = "D" And Chr(bytes(j + 3)) = "F" Then
                startPos = j
                Exit For
            End If
        Next j
        
        ' Chercher %%EOF la fin
        endPos = -1
        For j = UBound(bytes) - 5 To startPos + 4 Step -1
            If Chr(bytes(j)) = "%" And Chr(bytes(j + 1)) = "%" And Chr(bytes(j + 2)) = "E" And Chr(bytes(j + 3)) = "O" And Chr(bytes(j + 4)) = "F" Then
                endPos = j + 4
                Exit For
            End If
        Next j
        
        ' Extraire et écrire le PDF
        If startPos >= 0 And endPos > startPos Then
            ReDim pdfBytes(endPos - startPos) As Byte
            For j = startPos To endPos
                pdfBytes(j - startPos) = bytes(j)
            Next j
            
            Set stream = CreateObject("ADODB.Stream")
            stream.Type = 1
            stream.Open
            stream.Write pdfBytes
            stream.SaveToFile pdfPath, 2
            stream.Close
        Else
            MsgBox "PDF non trouvé dans " & binPath
        End If
    Next i
    
    'ouvrir les pdfs
    appdefaut = GetPdfDefaultExe
    MsgBox appdefaut.ExeName
    For i = 2 To col.Count
       If Right(col(i), 4) = ".pdf" Then Shell """" & appdefaut.ExeName & """ """ & """" & col(i) & """"
    Next
    
    ' Étape 3 : Nettoyage des fichiers bin
    For i = 1 To col.Count
         If Right(col(i), 4) <> ".pdf" Then Kill col(i)
    Next i
    
    MsgBox "Extraction terminée et fichiers bin supprimés."
End Sub

pas compliqué avec ma toute petite fonction de rien du tout
qui va chercher là ou il faut le chemin de l'exe par defaut pour les pdfs

Patrick
chez moi c'est edge par défaut même si j'ai AGrosseDaube reader
demo4.gif
 
- 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
Retour