Enregistrement PDF

Bonjour,

Je recherche un code qui :

Ouvre la fenêtre " enregistrer sous"
Que par défaut le dossier suggérer est celui du fichier excel ouvert
Le format suggérer est PDF
Le nom suggérer du fichier PDF est contenu dans une cellule (Feuille config, cellule B2)

Sauf exception l'utilisateur à donc juste à appuyer sur "enregistrer"

Merci pour votre aide :-)

Bonjour toutes et tous

@Indian901 @méliorer

merci à Banzaï64^^

2 onglets, Feuil1 et Config, + 1 bouton sauvegarder et dans l'onglet Config en B2 une valeur qui prendra le nom du Pdf

ci-joint

Option Explicit
'------------------------
' merci à Banzai64
' source: https://forum.excel-pratique.com/excel/macro-enregistrer-en-pdf-avec-nom-cellule-t74564.html
' modif Andre13
'------------------------
Sub PassationPDF()
Dim Chemin As String, NomFichier As String
On Error Resume Next

 ''' ' NomFichier = Range("b2").Value & "_" & Format(Date, "dd_mm_yyyy") & "_Passation" & ".pdf"
  ''' 'NomFichier = Range("b2").Value & "_" & Range("G2").Value & "_Passation" & ".pdf"

' ou
'NomFichier = Sheets("Config").Range("b2").Value & "_" & "_Passation" & ".pdf"
' ou
' NomFichier = Range("b2").Value & "_" & Format(Date, "dd_mm_yyyy") & "_BLABLABLA" & ".pdf"

NomFichier = Sheets("Config").Range("b2").Value & "_" & ".pdf"

  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then    ' Clic sur Ok
     Chemin = .SelectedItems(1)
    Else
      ' Clic sur Annuler
     Exit Sub
    End If
  End With

  Sheets("Feuil1").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & NomFichier, _
                                          Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                          IgnorePrintAreas:=False, OpenAfterPublish:=True

'msgbox"Effectué avec Succès" ' facultatif non mis actuellement
End Sub

crdlt,

André

Bonjour India, Salut Andre ,

Voici une proposition similaire : le seul changement est l'utilisation d'une boite de dialogue saveas.

La macro est appelée par une macro principale. On passe le nom de la feuille à exporter et le chemin par défaut en arguments de la procédure :

Sub Main()
nomdefaut$ = ThisWorkbook.Path & "\" & Sheets("Config").Range("b2").Value & ".pdf"
SavePDF Sheets("Feuil1"), nomdefaut '<<<arguments
end sub

Sub SavePDF(FeuilleExport as worksheet, optional vdefaut$)
Chemin = Application.GetSaveAsFilename(vdefaut, "PDF, *.pdf") 'boite dialogue avec chemin et filtre renvoie chemin
If Not Chemin = False Then 'si chemin <> faux, donc si on a bien enregistré
    FeuilleExport.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, IgnorePrintAreas:=False 'export
End If
End Sub

Cdlt,

Bonjour toutes et tous et bon weekend ^week-end

Je vais tester cela tout à l'heure car, il faut que je créer un classeur test pour comprendre ce fonctionnement, merci 3Gb ^^

crdlt,

André

Merci André, bon week-end également !

C'est le même fonctionnement que toi : On ouvre une boite de dialogue et la sélection permet de renvoyer une valeur dans une variable, celle de notre chemin.

Mais avec la boite de dialogue msoFileDialogFolderPicker, je crois (pas sûr) que le chemin est limité au répertoire et ça ne laisse pas la possibilité à l'utilisateur d'effectuer un changement de nom de fichier.

Cdlt,

Re,

merci 3Gb pour l'info exact, je ne connaissais-pas comme tu as fait

j'ai juste déclaré car, j'ai en entête de la feuille Option Explicit les 2 variables, aussi non perfect !^^

' 3 Gb merci ci-dessous ^^

Option Explicit ' <==
'
Sub Main()
On Error Resume Next
Dim nomdefaut$
nomdefaut$ = ThisWorkbook.Path & "\" & Sheets("Config").Range("b2").Value & ".pdf"
SavePDF Sheets("Feuil1"), nomdefaut '<<<arguments
End Sub

Sub SavePDF(FeuilleExport As Worksheet, Optional vdefaut$)
Dim Chemin
Chemin = Application.GetSaveAsFilename(vdefaut, "PDF, *.pdf") 'boite dialogue avec chemin et filtre renvoie chemin
If Not Chemin = False Then 'si chemin <> faux, donc si on a bien enregistré
    FeuilleExport.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, IgnorePrintAreas:=False 'export
End If
End Sub

crdlt,

André

Merci à vous 2 pour vos solutions, cela fonctionne

Cordialement