Discussion :

[stef3700]

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

[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

[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

[kiki29]

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

[stef3700]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[kiki29]

Salut, qqch dans le genre ci-dessous

de la lecture :

• Manipulation des fichiers en VBA
• Early Late Binding

P.-S. : Pour baliser ton code

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
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

[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

[kiki29]

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 :

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
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

[stef3700]

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

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

[kiki29]

Re, à adapter pour les noms et nombre de feuilles

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
 
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

[stef3700]

Merci beaucoup je test puis je vous tient au jus
T un chef

[stef3700]

Encore Merci Fonctionne Nikel

Longue vie au FOFO

[munff]

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 :

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
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,