Export PDF

Bonjour à tous,

J'ai une macro qui permet d'exporter une feuille Excel au format PDF.

La macro fonctionne plutôt bien après plusieurs tests.

J'aimerai optimiser cette macro et apporter des sécurités mais cela dépasse mes aptitudes.

Pouvez-vous m'éclairer sur ces différents points ?

• Lorsque la macro ouvre la fenêtre parcourir les dossiers, si je clique sur "Annuler", la macro s'exécute quand même et enregistre le PDF. Je n'ai pas de solutions pour ce petit inconvénient.
• Autre petit problème, si un fichier existe avec le même nom, la macro va écraser l'ancien par le nouveau. Et ça, c'est pas bon du tout.

- Un petit plus, serait d'enregistrer le dernier chemin utilisé pour enregistrer le fichier. C'est possible ça ?

voici le code :

Sub Exporter()

Dim msg As String
    msg = MsgBox("Souhaitez-vous enregistrer cette feuille en PDF ?", vbQuestion + vbYesNo, "Exporter  PDF")
    If msg = vbNo Then
        Exit Sub
    End If

Dim cpt_i As Long
Dim ligne_depart As Long
Dim ligne_fin As Long

Dim Chemin As String
Dim x As Long

With Application.FileDialog(msoFileDialogFolderPicker)
    'Définit un titre pour la boîte de dialogue
    .Title = "Sélectionnez le répertoire dans lequel exporter"
    'Affiche la boîte de dialogue
    .Show

    'Affiche le nom du dossier sélectionné
    If .SelectedItems.Count > 0 Then
        Chemin = .SelectedItems(1)
    End If

End With

If Chemin = "" Then Chemin = ThisWorkbook.Path

Application.ScreenUpdating = False

ligne_depart = 11
ligne_fin = ligne_depart

'mise en page

With ThisWorkbook.Sheets("Export pdf").PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(0.25)
    .BottomMargin = Application.InchesToPoints(0.25)
    .HeaderMargin = Application.InchesToPoints(0.05)
    .FooterMargin = Application.InchesToPoints(0.05)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    '.PrintQuality = 600
    .CenterHorizontally = True
    .CenterVertically = False
    .Orientation = xlPortrait
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 100
    .PrintErrors = xlPrintErrorsDisplayed
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
    .EvenPage.LeftHeader.Text = ""
    .EvenPage.CenterHeader.Text = ""
    .EvenPage.RightHeader.Text = ""
    .EvenPage.LeftFooter.Text = ""
    .EvenPage.CenterFooter.Text = ""
    .EvenPage.RightFooter.Text = ""
    .FirstPage.LeftHeader.Text = ""
    .FirstPage.CenterHeader.Text = ""
    .FirstPage.RightHeader.Text = ""
    .FirstPage.LeftFooter.Text = ""
    .FirstPage.CenterFooter.Text = ""
    .FirstPage.RightFooter.Text = ""
End With

ThisWorkbook.Sheets("Export pdf").PageSetup.PrintArea = ""
ThisWorkbook.Sheets("Export pdf").Range("A" & ligne_depart & ":F" & ThisWorkbook.Sheets("Export pdf").UsedRange.Rows.Count).Select
With Selection
    .HorizontalAlignment = xlLeft
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

ThisWorkbook.Sheets("Export pdf").PageSetup.PrintArea = "$A$1:$F$" & ThisWorkbook.Sheets("Export pdf").UsedRange.Rows.Count
ThisWorkbook.Sheets("Export pdf").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Format(Now, "yyyy mm dd ") & "- Material Order " & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

End Sub

Merci par avance pour votre aide.

Bonne journée.

Bonjour,

si je clique sur "Annuler"

   If .SelectedItems.Count > 0 Then
        Chemin = .SelectedItems(1)
    Else
        MsgBox "aucun dossier sélectionné"
        Exit Sub
    End If

si un fichier existe avec le même nom

Txt = Dir(Chemin & "\" & Format(Now, "yyyy mm dd ") & "- Material Order " & ".pdf")
If Txt = "" Then
   MsgBox "Le fichier n'existe pas"
Else
    MsgBox "Le fichier " & Txt & " Existe"
End If

Bonjour SabV,

C'est super c'est exactement ça, il me manquait pas grand chose. Tout fonctionne très bien !!

Merci pour ce coup de pouce, je commençait à ramer la dessus.

Bonne soirée !