Discussion :

[JPLCASI]

Bonjour à tous,

J'utilise actuellement la macro suivante qui permet d’enregistrer la feuille active au format PDF et de joindre le PDF à un e-mail pour l'envoyer directement ensuite. (Qui est très pratique )

Je souhaiterai appliquer cette macro sur un autre fichier mais qui comporte plusieurs feuilles.

Comment est il possible intégrer dans mon code la sélection des feuilles que je souhaite voir enregistrer dans mon PDF ? (Plusieurs feuilles dans le même PDF mais pas toutes...)

En vous remerciant d'avance pour votre aide.

Ci joint la macro utilisée :

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
58
Sub EnvoyerPDF()
    Call Envoyer_PDF("EnvoyerCourriel")
End Sub
 
 
Function Envoyer_PDF(Optional action As String = "EnregistrerSeulement") As Boolean  ' Copies sheets into new PDF file for e-mailing
    Dim CetteFeuille As String, CeFichier As String, NomRépertoire As String
    Dim EnrSous As String
 
Application.ScreenUpdating = False
 
' Obtention du nom de sauvegarde du fichier
    CetteFeuille = ActiveSheet.Name
    CeFichier = ActiveWorkbook.Name
    NomRépertoire = ActiveWorkbook.Path
    EnrSous = NomRépertoire & "\" & CetteFeuille & Sheets("RAPPORT PERF ").Range("B1") & ".pdf"
 
'Définition de la qualité d'impression
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0
 
' Explique à l'utilisateur comment envoyer le fichier
    On Error GoTo ErreurRefLib
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=EnrSous, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
 
' Création du courriel
    If action = "EnvoyerCourriel" Then
        On Error GoTo EnregistrerSeulement
        Set olApp = CreateObject("Outlook.Application")
        Set olEmail = olApp.CreateItem(olMailItem)
 
        With olEmail
            .Subject = CetteFeuille & ".pdf"
            .Attachments.Add EnrSous
            .Display
        End With
 
        On Error GoTo 0
        GoTo FinMacro
    End If
 
EnregistrerSeulement:
    MsgBox "Une copie de cette feuille a été sauvegardée avec succès en format .pdf " & vbCrLf & vbCrLf & EnrSous & _
        " Révisez le document .pdf. Si le document ne s'affiche pas correctement, ajustez vos paramètres d'impression et ré-essayez."
 
    Envoyer_PDF = True
    GoTo FinMacro
 
ErreurRefLib:
    MsgBox "Impossible de sauvegarder en pdf. Référence introuvable ou manquante."
    Envoyer_PDF = False
    GoTo FinMacro
 
FinMacro:
End Function

[Valtrase]

Salut,
En cachant les feuilles qui ne doivent pas faire partis du PDF

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Sub EnvoyerPDF()
    Call Envoyer_PDF(VBA.Array("Devis", "Contrats"), "EnvoyerCourriel")
End Sub
 
Function Envoyer_PDF(Values, Optional action As String = "EnregistrerSeulement") As Boolean    ' Copies sheets into new PDF file for e-mailing
    Dim CetteFeuille As String, CeFichier As String, NomRépertoire As String
    Dim EnrSous As String
    Application.ScreenUpdating = False
    Dim wks As Worksheet
    Dim Ele, bVisible As XlSheetVisibility
 
    ' Obtention du nom de sauvegarde du fichier
    CetteFeuille = Values(0) ' // On prends la première feuille du Array   'ActiveSheet.Name
    CeFichier = ActiveWorkbook.Name
    NomRépertoire = ActiveWorkbook.Path
    EnrSous = NomRépertoire & "\" & Sheets("RAPPORT PERF ").Range("B1") & "\" & CetteFeuille & ".pdf"
 
 
    'Définition de la qualité d'impression
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0
 
 
' // Ici on cache les feuilles qui ne seront pas dans le PDF
    bVisible = xlSheetHidden
    For Each wks In ThisWorkbook.Worksheets
        For Each Ele In Values
            If UCase(wks.Name) = UCase(Ele) Then
                bVisible = xlSheetVisible
            End If
        Next
        wks.Visible = bVisible: bVisible = xlSheetHidden
    Next
 
    ' Explique à l'utilisateur comment envoyer le fichier
    On Error GoTo ErreurRefLib
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=EnrSous, Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                                     IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
 
 
    '' Création du courriel
    '    If action = "EnvoyerCourriel" Then
    '        On Error GoTo EnregistrerSeulement
    '        Set olApp = CreateObject("Outlook.Application")
    '        Set olEmail = olApp.CreateItem(olMailItem)
    '
    '        With olEmail
    '            .Subject = CetteFeuille & ".pdf"
    '            .Attachments.Add EnrSous
    '            .Display
    '        End With
    '
    '        On Error GoTo 0
    '        GoTo FinMacro
    '    End If
 
 
EnregistrerSeulement:
    MsgBox "Une copie de cette feuille a été sauvegardée avec succès en format .pdf " & vbCrLf & vbCrLf & EnrSous & _
           " Révisez le document .pdf. Si le document ne s'affiche pas correctement, ajustez vos paramètres d'impression et ré-essayez."
 
 
    Envoyer_PDF = True
    GoTo FinMacro
 
 
ErreurRefLib:
    MsgBox "Impossible de sauvegarder en pdf. Référence introuvable ou manquante."
    Envoyer_PDF = False
    GoTo FinMacro
 
 
FinMacro:
    For Each wks In ThisWorkbook.Worksheets
        wks.Visible = xlSheetVisible
    Next
 
 
End Function

[JPLCASI]

C'est parfait !

Je te remercie pour la solution.