Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Enregistrement PDF + Excel dans un dossier

  • Initiateur de la discussion Initiateur de la discussion ynx69
  • 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 !

ynx69

XLDnaute Junior
Bonjour tous le monde,

J'aurais besoin d'aide pour réaliser une petite macro.

Je dispose d'un classeur avec n feuilles. Je souhaite exporter ce classeur au format pdf en ne comptant pas deux feuilles spécifiques ( qui portent respectivement le nom "A" et "B").

Pour exporter ce classeur, je souhaiterais que l'utilisateur indique le nom qu'il souhaite donner à son fichier pdf ainsi que le dossier dans lequel il souhaite l'enregistrer.

Lors de l'enregistrement je souhaiterais que le programme : enregistre le classeur au format excel et place dans le meme temps le classeur sous le même nom dans le même dossier que le pdf.

Avez-vous une idée de comment procéder ?

J'ai vu des discussions mais rien ne traite de cette problématique..

Merci d'avance pour votre aide
 
Bonjour ynx69,

Voyez le fichier joint et cette macro :
Code:
Sub Exporter()
Dim exclu, wb As Workbook, w As Worksheet, nom$, dossier$, chemin$, pa As Range, n%
exclu = Array("A", "B") 'noms des feuilles exclues
'---copie dans un document auxiliaire---
Application.ScreenUpdating = False
Set wb = Workbooks.Add(xlWBATWorksheet)
For Each w In ThisWorkbook.Worksheets
    If IsError(Application.Match(w.Name, exclu, 0)) Then
        w.Copy After:=wb.Sheets(wb.Sheets.Count)
        wb.Sheets(wb.Sheets.Count).UsedRange = w.UsedRange.Value 'supprime les formules
        wb.Sheets(wb.Sheets.Count).Name = w.Name
    End If
Next
If wb.Sheets.Count = 1 Then wb.Close False: Exit Sub
'---création des fichiers Excel et PDF---
nom = InputBox("Nom du fichier à créer, SANS EXTENSION :", , "MonFichier")
If nom = "" Then wb.Close False: Exit Sub
dossier = InputBox("Nom du sous-dossier à créer, SANS ANTISLASH \ :", , "MonDossier")
If dossier = "" Then wb.Close False: Exit Sub
Application.DisplayAlerts = False
wb.Sheets(1).Delete
chemin = ThisWorkbook.Path & "\" & dossier & "\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du sous-dossier
wb.SaveAs chemin & nom 'classeur Excel
Set w = wb.Sheets(1)
Set pa = w.UsedRange
For n = 2 To wb.Sheets.Count
    With w.Rows(w.UsedRange.Row + w.UsedRange.Rows.Count + 1) 'décalage d'une ligne
        wb.Sheets(n).UsedRange.EntireRow.Copy .Cells
        Set pa = Union(pa, Intersect(w.UsedRange, .Resize(w.Rows.Count - .Row + 1)))
    End With
Next
w.PageSetup.Zoom = False
w.PageSetup.FitToPagesWide = 1 'une page en largeur
w.PageSetup.PrintArea = pa.Address 'zone d'impression multiple
w.ExportAsFixedFormat xlTypePDF, chemin & nom, Quality:=xlQualityStandard 'fichier PDF
wb.Close False 'fermeture du fichier Excel
Application.ScreenUpdating = True
MsgBox "Les fichiers '" & nom & "' ont été créés..."
End Sub
A+
 

Pièces jointes

Hello @job75 : Je reviens vers toi concernant la macro ci dessus .

Après test j'ai quelques point que j'aimerais corriger mais je n'y arrive pas :

Le dossier d'enregistrement : serait-il possible , non pas d'enregistrer les fichiers dans un sous dossier nommé par l'utilisateur mais vraiment que celui-ci aille selectionner lui même le chemin ( comme quand on televerse un fichier dans le forum ) ?

Au total, la macro enregistre 4 fichier, serait-il possible de supprimer les fichiers "Mon fichier" et de garder uniquement deux fichiers avec le nom qu'aura choisi l'utilisateur.

Dans l'attente de ton retour,

Ynx
 
- 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

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…