Enregistrement excel en PDF par macro

Version imprimable

06/04/2017, 21h44
stef3700

Enregistrement excel en PDF par macro

Bonjour a tous novice en macro

*1 Voila je voudrais avoir une macro pour enregistre mon fichier Excel en PDF avec le même nom puis au même endroit que la source du fichier , sans changer son nom bien sur,
*2 Puis d'enregistré automatiquement en même tant en Excel (.xls)
*3 Puis d'ouvrir le PDF pour vérifier ma mise en page.
*4 Puis de fermée l'ensemble.

pour évité de sélectionné les actions que Excel nous propose du fait de choisir enregistre sous puis de choisir le format PDF puis la destination de l'enregistrement.

Voila si possible en une action donc la macro enfin j'espère ;);)

Merci d'avance pour tous

Cdt
06/04/2017, 22h05
kiki29

Salut, voir Excel et l'enregistreur de macro
En bas de ce post 1 la dernière partie intitulée : Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant

P.-S. : Ce n'est pas le bon forum. D'urgence Antidote
06/04/2017, 22h29
stef3700

Merci pour ta réponse rapide mais rien ne fonctionne
sachant que je suis novice dans ce domaine.

puis si je me trompe pas je ne vois pas pour qu'il enregistre avec le même nom que l'original.

Merci
06/04/2017, 22h50
kiki29

Re, l'enregistreur de macros te fournira un embryon de code qu'il te faudra optimiser à la main.

Re voici ca avance
Jai trouver ceci;
Mais je ne trouve pas comment enregistrée dans le même dossier ou se trouve la source.

De l'aide merci....

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Enregistrer_pdf_original()
 
Rep = MsgBox("Voulez-vous sauvegarder en pdf ?", vbYesNo)
     If Rep = vbYes Then
 
 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True
 
     End If
 
End Sub

Salut, qqch dans le genre ci-dessous

de la lecture :

P.-S. : Pour baliser ton code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
Sub Enregistrer_pdf_original()
Dim Rep As Long, sFichier As String
Dim FSO As Object
 
    Rep = MsgBox("Voulez-vous sauvegarder en pdf ?", vbYesNo)
    If Rep = vbYes Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        sFichier = ThisWorkbook.Path & "\" & FSO.GetBaseName(ThisWorkbook.Name)
        Set FSO = Nothing
 
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, _
                                        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                        IgnorePrintAreas:=False, OpenAfterPublish:=True
    End If
End Sub

07/04/2017, 13h11
stef3700

Merci kiki29 fonctionne Nikel
ou la vache ta réponse a 4 heures du mat ca déchire;)

y a-t-il la possibilité d'avoir un message si le fichier PDF existe déjà avant de l'écraser en message de type box par oui ou non

puis aussi qu'il effectue une sauvegarde du fichier Excel aussi en même tant.

merci d'avance

Salut, pour la sauvegarde au format Excel, je te laisse le soin de poursuivre. Se méfier de ce genre de messages en cascade du style "voulez-vous écraser ce fichier", "êtes vous sur de l'écraser", "bon on va l'écraser" qui lassent très vite l'utilisateur et ne le responsabilise pas.

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
Option Explicit
 
Sub Enregistrer_pdf_original()
Dim Rep As Long, Rep2 As Long, sFichier As String
Dim FSO As Object
 
    Rep = MsgBox("Voulez-vous sauvegarder en pdf ?", vbYesNo)
    If Rep = vbYes Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        sFichier = ThisWorkbook.Path & "\" & FSO.GetBaseName(ThisWorkbook.Name) & ".pdf"
 
        If FSO.FileExists(sFichier) Then
            Rep2 = MsgBox("Le fichier pdf existe déjà, confirmer son écrasement ?", vbYesNo)
            If Rep2 = vbYes Then
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, _
                                                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                                IgnorePrintAreas:=False, OpenAfterPublish:=True
            End If
        Else
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, _
                                            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                            IgnorePrintAreas:=False, OpenAfterPublish:=True
 
        End If
        Set FSO = Nothing
    End If
End Sub

07/04/2017, 15h03
stef3700

Encore merci pour ta rapidité tes un chef........:bravo:

Pour ne pas abuser est-il possible d'enregistrée en PDF un ensemble d'onglet donc pas la totalité en même temps

par exemple onglet AVIS 1 ; AVIS 2 AVIS 3 ; AVIS 4

Merci encore

Cdt

Re, à adapter pour les noms et nombre de feuilles

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
 
Sub Enregistrer_pdf_original()
Dim Rep As Long, sFichier As String
Dim FSO As Object
 
    Rep = MsgBox("Voulez-vous sauvegarder en pdf ?", vbYesNo)
    If Rep = vbYes Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        sFichier = ThisWorkbook.Path & "\" & FSO.GetBaseName(ThisWorkbook.Name) & ".pdf"
 
        If FSO.FileExists(sFichier) Then
            Rep = MsgBox("Le fichier pdf existe déjà, confirmer son écrasement ?", vbYesNo)
            If Rep = vbYes Then SavePDF sFichier
        Else
            SavePDF sFichier
        End If
        Set FSO = Nothing
    End If
End Sub
 
Private Sub SavePDF(sNomFichier As String)
Dim Ar(1) As String
 
    Ar(0) = "Feuil1"
    Ar(1) = "Feuil3"
 
    Application.ScreenUpdating = False
    Sheets(Ar).Select
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=sNomFichier, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
    Sheets("Feuil1").Select
    Application.ScreenUpdating = True
End Sub

07/04/2017, 17h12
stef3700

Merci beaucoup je test puis je vous tient au jus
T un chef:applo:
09/04/2017, 01h27
stef3700

Encore Merci Fonctionne Nikel

Longue vie au FOFO :resolu:

Macro PDF

BOnjour,

Merci pour cette macro.
Est-il possible d'ajouter dans la macro la possibilité de nommer le fichier enregistrer ainsi que le chemin ?

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
Option Explicit
 
Sub Enregistrer_pdf_original()
Dim Rep As Long, Rep2 As Long, sFichier As String
Dim FSO As Object
 
    Rep = MsgBox("Voulez-vous sauvegarder en pdf ?", vbYesNo)
    If Rep = vbYes Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        sFichier = ThisWorkbook.Path & "\" & FSO.GetBaseName(ThisWorkbook.Name) & ".pdf"
 
        If FSO.FileExists(sFichier) Then
            Rep2 = MsgBox("Le fichier pdf existe déjà, confirmer son écrasement ?", vbYesNo)
            If Rep2 = vbYes Then
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, _
                                                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                                IgnorePrintAreas:=False, OpenAfterPublish:=True
            End If
        Else
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, _
                                            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                            IgnorePrintAreas:=False, OpenAfterPublish:=True
 
        End If
        Set FSO = Nothing
    End If
End Sub

Merci.
Cordialement,