XL 2016 Enregistrement PDF + Excel dans un dossier

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
 

job75

XLDnaute Barbatruc
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+
 

Fichiers joints

ynx69

XLDnaute Junior
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
 

job75

XLDnaute Barbatruc
Bonjour ynx69,

Dans ce fichier (2) le dossier d'enregistrement est choisi avec Application.FileDialog.

Pourquoi parlez-vous de 4 fichiers créés ??? Les fichiers "MonFichier" sont créés si vous ne modifiez pas ce nom dans l'InputBox.

A+
 

Fichiers joints

Discussions similaires


Haut Bas