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
 
Bonjour,
J'ai remplacé les Set stream = CreateObject("ADODB.Stream") par un FSO.OpenTextFile.
VB:
        'Rename le .bin en .txt
        Name binPath As txtPath
        
        'Lecture du fichier .txt du répertoire TEMP
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oTextFile = oFSO.OpenTextFile(txtPath, ForReading)
        Text = oTextFile.readall
        oTextFile.Close

        'Start of PDF
        startPos = InStr(Text, "%PDF")
        
        'End of PDF
        endPos = InStrRev(Text, "%%EOF")
        endPos = endPos + 4
MsgBox "Len(Text) = " & Len(Text) & ", startPos = " & startPos & ", endPos = " & endPos

Pourquoi je ne trouve pas "%PDF" dans le texte lu alors que je le vois sur Notepad ?

1760945697703.png
 
re je vais essayer de l'expliquer plus clairement
ceci "%PDF" est ecrit dans le fichier en binaire
autrement dit c'est ecrit avec 4 nombres
pour lire ce nombre en lettre c'est chrw$(nombre)
et pour les caractère particulier c'est encore un autre calcul a faire avant de lire le caractère en lettre
 
Bonjour @nullosse,
Ok il y a des caractères de control, mais bon, ils font partie du texte, non ?
Pour lire un fichier en binaire y a que ADODB.Stream ?
Non,
tu peux le faire aussi avec du VBA pur. Exemple que m'a fourni le matou intelligent :
VB:
Sub ExtrairePDFDepuisBinaire()
    Dim sourcePath As String
    Dim destPath As String
    Dim fileNum As Integer
    Dim bytes() As Byte
    Dim i As Long
    Dim startPos As Long
    Dim fileSize As Long
   
    ' ?? Chemin du fichier source
    sourcePath = "C:\temp\oleObject2.bin"
    ' ?? Chemin du fichier PDF de sortie
    destPath = "C:\temp\fichier_extrait.pdf"
   
    ' ?? Ouvrir le fichier source en binaire
    fileNum = FreeFile
    Open sourcePath For Binary Access Read As #fileNum
    fileSize = LOF(fileNum)
    If fileSize = 0 Then
        MsgBox "Fichier vide : " & sourcePath, vbExclamation
        Close #fileNum
        Exit Sub
    End If
   
    ReDim bytes(1 To fileSize)
    Get #fileNum, , bytes
    Close #fileNum
   
    ' ?? Chercher la séquence %PDF (ASCII 37, 80, 68, 70)
    For i = 1 To fileSize - 3
        If bytes(i) = 37 And bytes(i + 1) = 80 And bytes(i + 2) = 68 And bytes(i + 3) = 70 Then
            startPos = i
            Exit For
        End If
    Next i
   
    If startPos = 0 Then
        MsgBox "Signature %PDF non trouvée dans " & sourcePath, vbExclamation
        Exit Sub
    End If
   
    ' ?? Extraire tout à partir de %PDF jusqu'à la fin
    Dim outBytes() As Byte
    ReDim outBytes(1 To fileSize - startPos + 1)
   
    Dim j As Long
    For j = 1 To UBound(outBytes)
        outBytes(j) = bytes(startPos + j - 1)
    Next j
   
    ' ?? Écrire dans le nouveau fichier PDF
    fileNum = FreeFile
    Open destPath For Binary Access Write As #fileNum
    Put #fileNum, , outBytes
    Close #fileNum
   
    MsgBox "Extraction terminée !" & vbCrLf & _
           "PDF enregistré sous : " & destPath, vbInformation
End Sub
 
Bonjour @nullosse,
Ok il y a des caractères de control, mais bon, ils font partie du texte, non ?
Pour lire un fichier en binaire y a que ADODB.Stream ?
non tu peux le faire avec open for aussi (for read as binary)
mais dans tout les cas il te faut convertir chaque bits en lettre
alors que finalement adobd.stream le fait tout seul et est bien plus performent que tout autre méthode il n'y a même pas photo
je parle la d'outils dispo pour vba bien sur
par ordre de rapidité
adobd.stream
FSO
open for
mais pourquoi pas essais donc ceci

VB:
Sub lecture1()    ' recupe le texte complet  avec binary acces read
    Dim laChaine As String, x, fichier As String
    fichier = "C:\Users\polux\Desktop\ttt.txt"'adapter ici le chemin 
    x = FreeFile
    Open fichier For Binary Access Read As #x
    laChaine = String(LOF(x), " ")
    Get #x, , laChaine
    Close #x
    MsgBox laChaine'lachaine contient tout le texte utilisable
End Sub
 
Get et Put je ne m'en souvenais plus.
Donc sur la base des Get et Put du chat péteur rapporté par @nullosse, voici le code pour afficher un Embbeded PDF avec Acrobat lorsqu'on n'a pas Acrobat, c'est à dire quand le Shape.OLEFormat.Verb xlPrimary part en erreur 1004.
 
Dernière édition:
- 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