XL 2016 Décocher l'option 'Compatible ISO 19005-1 (PDF/A)' lors d'un export

MinnieChat

XLDnaute Nouveau
Bonjour à tous,


Nouvelle sur ce forum, voici ma première question , qui j'espère trouvera sa solution auprès de l'un de vous ! :)

Dans le cadre de mon boulot, j'ai réalisé un fichier excel, comportant des onglets filtres (multiple TcD) et un onglet récap que je souhaiterai pouvoir exporter en PDF directement via un bouton "Enregistrer mon PDF".
Ces pages exportables se trouvent sur l'onglet recap (nommé "Export du fichier en PDF") du fichier Excel et comporte des graphes, des images et des zones de textes.
J'ai réussi à réaliser une macro qui m'enregistre bien mes pages de cet onglet en format PDF, avec le nommage que je souhaite, et dans le bon dossier, SAUF que, à l'ouverture du PDF, la plupart des graphes, images et zones de texte sont remplacées par des rectangles noirs aux contours bleus, rendant illisible mon PDF.

Après plusieurs test, je me suis rendue compte, qu'en exécutant la manipe manuellement "fichier - exporter - créer PDF/XPS" puis en décochant dans les options "Compatible ISO 19005-1 (PDF/A)", le problème d'affichage ne se produit plus !

Je souhaiterai donc pouvoir associer cette manipe à ma macro déjà en place ...
Après des dizaines de tentatives, j'abandonne ... et pose tous mes espoirs sur vous .😄


Voici la macro (légérement modifée par soucis de protection de données sensibles) qui fonctionne très bien hormis le problème d'affichage une fois qu'on ouvre le PDF :
Sub Export_PDF()
Dim fichier As String
Date_F = Format(Date, "yyyymmdd_")

'adaptez le nom de la feuille
With Worksheets("EXPORT du fichier EN PDF")
fichier = "\" & Date_F & .Range("B7") & ".pdf"
Dossier = "F:\E-CELLULE\...\- INDICATEURS\Indicateurs mensuels\2021"
Chemin = Dossier & fichier
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With

' Message de confirmation
MsgBox ("Votre PDF a bien été enregistré dans le dossier Indicateurs Mensuels" & vbCrLf & vbCrLf & "Vérifiez toutefois que vous avez bien sélectionné le bon mois dans l'onglet - TABLEAU DE BORD -." & vbCrLf & vbCrLf & " Merci !")
End Sub

Private Sub TextBox1_Change()
End Sub
Private Sub ScrollBar1_Change()

End Sub



Merci d’avance à celui ou celle qui saura m’apporter son aide :oops:
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Faites le manuellement avec l'enregistreur de macro en route et vous verrez la différence.
Au besoin faites le une fois en cochant (ou décochant) et une fois dans l'autre sens, comparez les deux macros.

C'est un paramètre tout simple, présent déjà dans votre ligne d'enregistrement qui est modifié :)

de IncludeDocProperties:=True à IncludeDocProperties:=False

Cordialement
 
Dernière édition:

MinnieChat

XLDnaute Nouveau
Merci pour ce retour.
Je reteste mardi en reprenant le travail.
Mais j'avais déjà tenter de le faire manuellement en enregistrant une macro test pour voir ce qui apparaissait quand je decochais l'option en question mais il n'y avait aucune différence avec le fait de ne pas la décocher ( sur la macro) ...😪
 

kiki29

XLDnaute Barbatruc
Salut, peut-être en sélectionnant un "setting" approprié d'Acrobat. Je précise il te faut Acrobat ( pas le Reader )
ici cela fonctionne, à toi de l'adapter à ton contexte.
VB:
Option Explicit

Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> "" And sFichier <> ""
End Function

Sub Tst_01()
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
Dim sNomFichierLOG As String
Dim PDFDist As Object
Dim sSetting As String

    sNomFichierPS = ThisWorkbook.Path & "\" & "Test_01.ps"
    sNomFichierPDF = ThisWorkbook.Path & "\" & "Test_01.pdf"
    sNomFichierLOG = ThisWorkbook.Path & "\" & "Test_012.log"

    Feuil1.Range("Zone").PrintOut Copies:=1, _
                                  Preview:=False, _
                                  ActivePrinter:="Adobe PDF", _
                                  PrintToFile:=True, _
                                  Collate:=True, _
                                  PrToFilename:=sNomFichierPS

    sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\Smallest File Size.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\High Quality Print.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\PDFA1b 2005 CMYK.joboptions"

    Set PDFDist = CreateObject("PdfDistiller.PdfDistiller")
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, sSetting
    Set PDFDist = Nothing

    If ExistenceFichier(sNomFichierPS) Then Kill sNomFichierPS
    If ExistenceFichier(sNomFichierLOG) Then Kill sNomFichierLOG
End Sub

une variante :
VB:
Option Explicit

Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> "" And sFichier <> ""
End Function

Private Function GetPrinterWithPort(sPrinterName As String) As String
Dim Reg As Variant, oReg As Object, Str As Variant
Dim Ar() As Variant, RegValue As Variant
Const HKEY_CURRENT_USER = &H80000001
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    With oReg
        .enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Str, Ar
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Reg, RegValue
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", sPrinterName, RegValue
    End With
    GetPrinterWithPort = sPrinterName & " sur " & Mid$(RegValue, InStr(RegValue, ",") + 1)
End Function

Sub Tst_02()
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
Dim sNomFichierLOG As String
Dim PDFDist As Object
Dim sSetting As String
Dim sPrinter As String

    sNomFichierPS = ThisWorkbook.Path & "\" & "Test_02.ps"
    sNomFichierPDF = ThisWorkbook.Path & "\" & "Test_02.pdf"
    sNomFichierLOG = ThisWorkbook.Path & "\" & "Test_02.log"

    sPrinter = GetPrinterWithPort("Adobe PDF")

    Feuil1.Range("Zone").PrintOut Copies:=1, _
                                  Preview:=False, _
                                  ActivePrinter:=sPrinter, _
                                  PrintToFile:=True, _
                                  Collate:=True, _
                                  PrToFilename:=sNomFichierPS

    sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\Smallest File Size.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\High Quality Print.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\PDFA1b 2005 CMYK.joboptions"

    Set PDFDist = CreateObject("PdfDistiller.PdfDistiller")
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, sSetting
    Set PDFDist = Nothing

    If ExistenceFichier(sNomFichierPS) Then Kill sNomFichierPS
    If ExistenceFichier(sNomFichierLOG) Then Kill sNomFichierLOG
 
End Sub
 

Pièces jointes

  • settings.jpg
    settings.jpg
    497.3 KB · Affichages: 37
Dernière édition:

MinnieChat

XLDnaute Nouveau
Salut, peut-être en sélectionnant un "setting" approprié d'Acrobat. Je précise il te faut Acrobat ( pas le Reader )
ici cela fonctionne, à toi de l'adapter à ton contexte.
VB:
Option Explicit

Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> "" And sFichier <> ""
End Function

Sub Tst_01()
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
Dim sNomFichierLOG As String
Dim PDFDist As Object
Dim sSetting As String

    sNomFichierPS = ThisWorkbook.Path & "\" & "Test_01.ps"
    sNomFichierPDF = ThisWorkbook.Path & "\" & "Test_01.pdf"
    sNomFichierLOG = ThisWorkbook.Path & "\" & "Test_012.log"

    Feuil1.Range("Zone").PrintOut Copies:=1, _
                                  Preview:=False, _
                                  ActivePrinter:="Adobe PDF", _
                                  PrintToFile:=True, _
                                  Collate:=True, _
                                  PrToFilename:=sNomFichierPS

    sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\Smallest File Size.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\High Quality Print.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\PDFA1b 2005 CMYK.joboptions"

    Set PDFDist = CreateObject("PdfDistiller.PdfDistiller")
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, sSetting
    Set PDFDist = Nothing

    If ExistenceFichier(sNomFichierPS) Then Kill sNomFichierPS
    If ExistenceFichier(sNomFichierLOG) Then Kill sNomFichierLOG
End Sub

une variante :
VB:
Option Explicit

Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> "" And sFichier <> ""
End Function

Private Function GetPrinterWithPort(sPrinterName As String) As String
Dim Reg As Variant, oReg As Object, Str As Variant
Dim Ar() As Variant, RegValue As Variant
Const HKEY_CURRENT_USER = &H80000001
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    With oReg
        .enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Str, Ar
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Reg, RegValue
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", sPrinterName, RegValue
    End With
    GetPrinterWithPort = sPrinterName & " sur " & Mid$(RegValue, InStr(RegValue, ",") + 1)
End Function

Sub Tst_02()
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
Dim sNomFichierLOG As String
Dim PDFDist As Object
Dim sSetting As String
Dim sPrinter As String

    sNomFichierPS = ThisWorkbook.Path & "\" & "Test_02.ps"
    sNomFichierPDF = ThisWorkbook.Path & "\" & "Test_02.pdf"
    sNomFichierLOG = ThisWorkbook.Path & "\" & "Test_02.log"

    sPrinter = GetPrinterWithPort("Adobe PDF")

    Feuil1.Range("Zone").PrintOut Copies:=1, _
                                  Preview:=False, _
                                  ActivePrinter:=sPrinter, _
                                  PrintToFile:=True, _
                                  Collate:=True, _
                                  PrToFilename:=sNomFichierPS

    sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\Smallest File Size.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\High Quality Print.joboptions"
    'sSetting = "C:\Program Files (x86)\Adobe\Acrobat 2015\Acrobat\Settings\PDFA1b 2005 CMYK.joboptions"

    Set PDFDist = CreateObject("PdfDistiller.PdfDistiller")
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, sSetting
    Set PDFDist = Nothing

    If ExistenceFichier(sNomFichierPS) Then Kill sNomFichierPS
    If ExistenceFichier(sNomFichierLOG) Then Kill sNomFichierLOG

End Sub
Bonjour,
J'aurai tellement aimé qu'il s'agisse de la solution à mon problème mais malheureusement là où je travaille c'est "Adobe Acrobat Reader" qui a été choisi par les administrateurs. Et je ne peux rien changer. Je travaille sur du classifié, je ne peux pas faire n'importe quoi avec les machines ...
 

MinnieChat

XLDnaute Nouveau
Pourtant c'est le seul paramètre qui change quand on coche ou décoche l'option.

A suivre...
Bonjour,

Bon et bien j'avais hâte de reprendre le travail pour pouvoir tester mais à mon grand désespoir ça ne fonctionne pas non plus.
J'ai testé les deux manipes en manuel (une fois en laissant la case cochée, une fois en la décochant) mais déjà, le "IncludeDocProperties:=" reste en "True" pour les deux manipes.
J'ai ensuite essayé de le modifier moi même dans le visual Basic, en mettant "False" à la place de "True" mais quand je lance la macro j'ai toujours ce même résultat ... : la plupart des graphes, images et zones de texte sont remplacées par des rectangles noirs aux contours bleus, rendant illisible mon PDF. o_Oo_Oo_O (voir PJ)
 

Pièces jointes

  • test forum.pdf
    626.1 KB · Affichages: 3

Discussions similaires

Réponses
2
Affichages
580