Bonjour à toute la communauté,

Je suis tombé sur un code qui date un peu mais qui fonctionne parfaitement pour enregistrer les onglets dans des fichiers excel distincts tout en gardant le nom de chaque onglet. merci @ouskel'n'or

Je souhaiterais faire la même chose en l'enregistrant au format pdf au lieu du format excel.

Malheureusement je n'y arrive pas en modifiant par exemple juste ceci : Type:=xlTypePDF

Pourriez-vous m'aider svp ? (je n'ai aucune connaissance en VBA particulièrement)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Enregistre_onglet_excel()
Dim ceFichier As Workbook
Dim nouveauFichier As Workbook
 
Set ceFichier = ActiveWorkbook
 
For Each fSheet In ceFichier.Worksheets
    Set nouveauFichier = Workbooks.Add
    DoEvents
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
    DoEvents
    nouveauFichier.SaveAs Filename:="chemin_pour_enregistrement" & "\" & fSheet.Name, FileFormat:=xlNormal
    DoEvents
    nouveauFichier.Close False
Next
 
ceFichier.Activate
 
End Sub

En poussant un peu la demande je suis tombé sur ceci qui permet de lister les noms de chaque onglets et selon le chiffre mis devant (0 ou 1) prend l'onglet dans la sélection.

Ce qui permet d'appliquer le code que pour les onglets sélectionnés.

Ceci est moins important que ma 1ère demande mais si c'est pas trop fastidieux serait-il possible de fusionner ces 2 idées de code ?

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
Sub List_onglet()
Dim i As Integer
 
    Range("B5").Select
 
    For i = 1 To Sheets.Count
        ActiveCell.Value = Sheets(i).Name
        ActiveCell.Offset(1, 0).Select
    Next i
 
End Sub
et le code qui faisait des actions par rapport à cette liste (le problème c'est que ça enregistre dans un même fichier .pdf l'ensemble des onglets et non dans un fichier .pdf distinct pour chaque onglets.).

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub SauverEnPDF()
 
' Un exemple de sauvegarde des onglets sélectionnés en PDF
 
Dim vararray() As String ' Afin de conserver les noms des onglets sélectionnés
Dim csname As Integer ' Colonne où se trouve le nom des onglets
Dim c As Integer ' Colonne où se trouve les choix 1 ou 0
Dim countarr As Integer ' Pour compter le nombre d'onglets sélectionnés
Dim r As Integer ' Pour compter à travers tous les onglets
Dim sname As Worksheet ' Nom de l'onglet de départ, pour y revenir à la fin
Dim strFileName As String ' Nom du fichier à sauvegarder
 
'set up location and counter variables
   csname = Range("B5").Column
   c = Range("C5").Column
   Set sname = ActiveSheet
   r = Range("C5").Row
   countarr = 0
 
' Boucle dans la iste des onglets tant qu'il y a un nom d'onglet
   While sname.Cells(r, csname) <> ""
 
' Ajouter le nom de l'onglet à la liste si le choix est 1
      If sname.Cells(r, c) = 1 Then
         ReDim Preserve vararray(countarr)
         ' Un ReDim Preserve permet d'augmenter la taille de la variable tout en préservant son contenu
         vararray(countarr) = sname.Cells(r, csname).Value
         countarr = countarr + 1
      End If
   r = r + 1
   Wend
 
' On sélection ensuite le groupe d'onglets sélectionnés
   Sheets(vararray).Select
 
   strFileName = Application.GetSaveAsFilename(filefilter:="PDF Files (*.pdf), *.pdf", Title:="Entrez le nom du fichier")
 
' Il faut s'assurer que l'usager a bel et bien fait un choix.
' Sinon, le nom du fichier sera false ou faux, si Excel français
 
   If strFileName <> "False" And strFileName <> "Faux" Then
 
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName _
       , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
       :=False, OpenAfterPublish:=False
 
' Ici, on va sauvegarder en fonction de la mise en page pour impression
 
   End If
 
' On sort en revenant à l'onglet de départ
 
   sname.Select
 
   set sname = Nothing
 
End Sub
Merci à tous pour votre / vos réponse(s).