Créer un PDF avec VBA

Jenni -  
T3chN0g3n Messages postés 5247 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour,

Est-ce possible de créer un PDF d'une feuille Excel afin d'afficher seulement la boite de dialogue pour pouvoir par la suite l'enregistrer sous à l'endroit approprié, car l'endroit peut changer. J'ai commencé par ça, mais je crois qu'il me manque quelque chose...

Sub Créer_PDF()

' Créer_PDF Macro

    Sheets(Array("TES T.PLEIN", "PEH T.PLEIN", "TES T.PARTIEL", "PEH T.PARTIEL")). _
        Select
    Sheets("TES T.PLEIN").Activate
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    ActiveWorkbook.Save
    Sheets("TES T.PLEIN").Select
End Sub

Merci à l'avance !


Windows / Chrome 113.0.0.0

A voir également:

3 réponses

Réponse 1 / 3
T3chN0g3n Messages postés 5247 Date d'inscription   Statut Membre Dernière intervention   1 179
 

Bonjour,

Oui c'est possible,  par exemple ici tu à la syntaxe pour exporter en pdf:

https://forums.commentcamarche.net/forum/affich-31001371-macro-enregistrer-en-pdf

Et ici la syntaxe pour ouvrir une boite de dialogue pour sélectionner le path:

https://stackoverflow.com/questions/33411063/select-folder-for-save-location

En faisant un mix des deux en 10mn voilà un premier jet : 

Sub Export_PDF()
    Dim DossSelect As FileDialog
    Dim Dossier As String
    Set DossSelect = Application.FileDialog(msoFileDialogFolderPicker)
    With DossSelect
        .Title = "Selectionnez l'emplacement de sauvegarde"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        Dossier = .SelectedItems(1)
    End With
    With ActiveSheet
        Chemin = Dossier & "\" & ActiveSheet.Name
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
Set DossSelect = Nothing
End Sub

Cdlt.

EDIT: J'avais pas vu ton ébauche, mais tu doit pouvoir adapter à ton besoin.
0
Réponse 2 / 3
Jenni
 

Oh super ! Ça fonctionne :)

Maintenant j'essaie d'ajuster pour sélectionner mes 4 feuilles, mais ça m'indique une code d'erreur d'exécution 424. (Objet requis)

Sub Export_PDF()
    Dim DossSelect As FileDialog
    Dim Dossier As String
    Set DossSelect = Application.FileDialog(msoFileDialogFolderPicker)
    With DossSelect
        .Title = "Selectionnez l'emplacement de sauvegarde"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        Dossier = .SelectedItems(1)
    End With
    With Worksheets(Array("TES T.PLEIN", "PEH T.PLEIN", "TES T.PARTIEL", "PEH T.PARTIEL")). _
        Select
        Chemin = Dossier & "\" & ActiveSheet.Name
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
Set DossSelect = Nothing
End Sub

Merci.
0
Réponse 3 / 3
T3chN0g3n Messages postés 5247 Date d'inscription   Statut Membre Dernière intervention   1 179
 

Ce qui plantait c'est apparemment le manque du "Selection" avant le .ExportAs... Mais il faut aussi "activer" les zones à imprimer avec cette méthode, donc faut rajouter un bloc:

Sub ExportMulti_PDF()
    Dim DossSelect As FileDialog
    Dim Dossier As String
    Set DossSelect = Application.FileDialog(msoFileDialogFolderPicker)
    With DossSelect
        .Title = "Selectionnez l'emplacement de sauvegarde"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        Dossier = .SelectedItems(1)
    End With
    
    Sheets("TEST 1").Activate
    ActiveSheet.UsedRange.Select
    Sheets("TEST 2").Activate
    ActiveSheet.UsedRange.Select
    Sheets("TEST 3").Activate
    ActiveSheet.UsedRange.Select
   
    With ThisWorkbook.Sheets(Array("TEST 1", "TEST 2", "TEST 3")).Select
        Chemin = Dossier & "\" & "NomDuFichier.pdf"
        Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
Set DossSelect = Nothing
End Sub

J'ai mis un nom de fichier fixe mais ont peut tout imaginer à ce niveau, le faire taper dans une fenêtre, récupérer d'une cellule, récupérer le nom du classeur ...
0