XL 2013 [RESOLU] [VBA] Problème conversion PDF

David2Coree

XLDnaute Junior
Bonjour à toutes et à tous,

Hier j'ai créé un post où je demandais comment je pouvais faire en VBA l'insertion de lignes automatique par rapport à un autre tableau dans un autre onglet post ici.
Grâce à l'aide PierreJean, j'ai trouvé le code VBA qui me permet d'effectuer cette action.

Mais lorsque j'intègre un nouveau module qui me permet de faire la conversion de mes 3 premiers onglets en PDF, je rencontre un souci d'exécution du PDFCreator.

En effet, sans le code de PierreJean, la macro s'exécute sans problème et me convertit mes 3 onglets.

Par contre, si j'intègre le code de PierreJean :
  1. PDFCreator reste en fond de tâche et n'exécute pas la conversion
  2. si je termine manuellement la conversion en cliquant sur la file d'impression en attente sous PDFCreator, ce dernier me converti que le 2nd et le 3ème onglet et zappe le 1er. Je ne comprends pas !
Croyez-vous qu'il y a une erreur de codage ?

Je vous remercie d'avance.

Cordialement
David
 

Pièces jointes

  • GESTION-STOCK_EDF_VB_PDF.xlsm
    52.3 KB · Affichages: 37

Lone-wolf

XLDnaute Barbatruc
Bonjour David :)

Fait un test avec cette fonction.

VB:
Option Explicit

Function Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant

    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Enregistrer Format PDF")
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0
        If Dir(Fname) <> "" Then Create_PDF = Fname
    End If
End Function

VB:
Option Explicit

Sub Conversion_Pdf()
    Dim FileName As String

    Worksheets("Convert Pdf").DisplayAutomaticPageBreaks = False

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "Attention! Il ya plus d'une feuille sélectionnée.", , "Conversion Pdf"
    End If

    FileName = Create_PDF(ActiveSheet, "", True, True)

    If FileName <> "" Then
    Else
        MsgBox "Attention! Vous avez annullé l'enregistrement.", , "Conversion Pdf"
    End If
End Sub
 

David2Coree

XLDnaute Junior
Bonjour David :)

Fait un test avec cette fonction.

VB:
Option Explicit

Function Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant

    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Enregistrer Format PDF")
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0
        If Dir(Fname) <> "" Then Create_PDF = Fname
    End If
End Function

VB:
Option Explicit

Sub Conversion_Pdf()
    Dim FileName As String

    Worksheets("Convert Pdf").DisplayAutomaticPageBreaks = False

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "Attention! Il ya plus d'une feuille sélectionnée.", , "Conversion Pdf"
    End If

    FileName = Create_PDF(ActiveSheet, "", True, True)

    If FileName <> "" Then
    Else
        MsgBox "Attention! Vous avez annullé l'enregistrement.", , "Conversion Pdf"
    End If
End Sub

Bonjour Lone-Wolf,

Merci tout d'abord de votre réponse rapide. J'ai essayé d'adapter vos macros mais je n'obtiens pas le résultat que je désire.
Cela me convertit qu'un seul onglet et moi je désire convertir les 3 premiers onglets.
Ce que je ne comprends pas, si j'exécute mon code actuel dans un autre fichier sans l'apport du code de PierreJean, j'ai la bonne conversion en PDF.
:-(
 

David2Coree

XLDnaute Junior
Bonjour à tout le forum !

Lone-wolf, kiki29, merci pour vos orientations VB mais j'ai trouvé la cause de mon problème !!!
Le codage n'était pas en cause mais juste une différence de mise en page de mes onglets ! La qualité d'impression de mon premier onglet était différente par rapport à mes 2 autres onglets !:confused:

Merci de votre participation et de l'attention que vous avez prêté à mon problème.:D