Export onglet distinct au format pdf
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:
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 ? :roll:
Code:
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:
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). :)
