Macro pour envoi PDF par courriel [Résolu]

[Ambrocbt]

J'ai lu cette discussion.
Merci pour le code

Code :

1
2
3
4
'exporter en format PDF
 ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dossierSauvegarde & "\" & NomFichier & ".pdf" _
 , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
 :=False, OpenAfterPublish:=False

Est il possible de prendre uniquement un range de cellules ( le même pour chaque feuille du classeur) et l'exporter dans le pdf.

[kiki29]

Salut, la réponse est oui, ici dans un seul Pdf résultant, à adapter

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
 
Sub Tsr()
Dim Ws As Worksheet
Dim Ar() As String, i As Long
 
    For Each Ws In ThisWorkbook.Worksheets
        Ws.PageSetup.PrintArea = "$A$1:$D$26"
        ReDim Preserve Ar(i)
        Ar(i) = Ws.Name
        i = i + 1
    Next Ws
 
    Sheets(Ar).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & "Test.pdf" _
                                                               , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                                                                                                                    :=False, OpenAfterPublish:=False
    Sheets(Ar(0)).Select
    Erase Ar
End Sub

ou feuille par feuille

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
 
Sub Tsr2()
Dim Ws As Worksheet
 
    For Each Ws In ThisWorkbook.Worksheets
        With Ws
            .PageSetup.PrintArea = "$A$1:$D$26"
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Ws.Name & ".pdf" _
                                                            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                                                                                                                      :=False, OpenAfterPublish:=False
        End With
    Next Ws
End Sub

[Ambrocbt]

Merci Kiki, Je viens d'essayer mais je ne génère pas de pdf :/

Voici le code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
Sub pdf()
Dim Ws As Worksheet
Dim Ar() As String, i As Long
 
    For Each Ws In ThisWorkbook.Worksheets
        Ws.PageSetup.PrintArea = "$A$10:$X$39"
        ReDim Preserve Ar(i)
        Ar(i) = Ws.Name
        i = i + 1
    Next Ws
 
    Sheets(Ar).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "C:\Users\utilisateur\Dropbox\Produits strucutrés\Ambroise\Defives\Bonimatif" & "test.pdf" _
                                                               , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                                                                                                                    :=False, OpenAfterPublish:=False
    Sheets(Ar(0)).Select
 
   Erase Ar
 
End Sub

[kiki29]

Salut, tu m'étonnes regarde ton chemin , encore un drame du copier coller

Code :

Filename:=ThisWorkbook.Path & "C:\Users\utilisateur\Dropbox\Produits strucutrés\Ambroise\Defives\Bonimatif" & "test.pdf"

Ceci devrait t'aller

Code :

Filename:="C:\Users\utilisateur\Dropbox\Produits strucutrés\Ambroise\Defives\Bonimatif" & "\"& "test.pdf"

[Ambrocbt]

C'est effectivement mieux comme ca.
Merci beaucoup.