Enregistrer sous avec nom du document VBA

Résolu/Fermé
NeOXi-_Alpha Messages postés 65 Date d'inscription mardi 13 novembre 2018 Statut Membre Dernière intervention 31 mai 2019 - 8 févr. 2019 à 14:39
NeOXi-_Alpha Messages postés 65 Date d'inscription mardi 13 novembre 2018 Statut Membre Dernière intervention 31 mai 2019 - 20 mars 2019 à 11:36
Bonjour,
actuellement j'ai fait un fichier excel qui se remplis automatiquement en fonction de valeur que l'on aura rentré et en suis j'ai un bouton enregistrer le PDF qui va permettre d'enregistrer mon PDF dans un chemin défini dans une cellule sauf que j'aimerai que ce chemin et se nom soit demander au moment ou je clic sur le bouton comme si on enregistrait sous un fichier.
voici mon code pour comprendre se que j'ai fait:

Dim Chemin As String
Dim Nom As String

Sub Enregistrer_PDF()

Nom = [K16]
Chemin = [K14]
If Len(Dir(Chemin, vbDirectory)) > 0 Then

If [D93] = "" Then
 Range("D1:G81").Select
 Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 Chemin & "/" & Nom, Quality:=xlQualityStandard, _
 IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
 False
Else
   If [D174] = "" Then
   Range("D1:G162").Select
   Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   Chemin & "/" & Nom, Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
   False
   Else
     If [D255] = "" Then
     Range("D1:G243").Select
     Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     Chemin & "/" & Nom, Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
     False
     Else
       Range("D1:G324").Select
       Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       Chemin & "/" & Nom, Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
       False
End If
End If
End If
MsgBox "Le Devis est enregistré dans " & Chemin & " au nom de " & Nom
   Else
      MsgBox "Le dossier de destination n'existe pas"
End If

End Sub


Dim a As Variant


merci de votre aide.

1 réponse

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
8 févr. 2019 à 15:12
1
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
5 mars 2019 à 13:46
comme ceci:

Sub Enregistrer_PDF()
Dim fileSaveName As String
Dim nom As String
Dim chemin As String
nom = [K16]
chemin = [K14]
If Len(Dir(chemin, vbDirectory)) > 0 Then

If [D93] = "" Then
 Range("D1:G81").Select
 fileSaveName = Application.GetSaveAsFilename(chemin & "\" & nom, "Fichier PDF (*.pdf), *.pdf")
 Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 fileSaveName, Quality:=xlQualityStandard, _
 IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
 False
Else
   If [D174] = "" Then
   Range("D1:G162").Select
    fileSaveName = Application.GetSaveAsFilename(chemin & "\" & nom, "Fichier PDF (*.pdf), *.pdf")
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   fileSaveName, Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
   False
   Else
     If [D255] = "" Then
     Range("D1:G243").Select
     fileSaveName = Application.GetSaveAsFilename(chemin & "\" & nom, "Fichier PDF (*.pdf), *.pdf")
     Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     fileSaveName, Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
     False
     Else
       Range("D1:G324").Select
       fileSaveName = Application.GetSaveAsFilename(chemin & "\" & nom, "Fichier PDF (*.pdf), *.pdf")
       Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       fileSaveName, Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
       False
End If
End If
End If
MsgBox "Le Devis est enregistré dans " & chemin & " au nom de " & nom
   Else
      MsgBox "Le dossier de destination n'existe pas"
End If

End Sub


@+ Le Pivert
0
NeOXi-_Alpha Messages postés 65 Date d'inscription mardi 13 novembre 2018 Statut Membre Dernière intervention 31 mai 2019
Modifié le 20 mars 2019 à 11:25
bonjour,
voila se que j'ai fait depuis la dernier foi je n'avais pas eu le temps de m'y pencher plus tôt mais du-coup j'ai faire un truc qui rend exactement se que je cherche a faire sauf que je n'arrive pas à lui donné le nom voulue pouvez vous m'aidez.

voici mon code:

Range("D1:G85").Select
            ActiveSheet.PageSetup.PrintArea = "D1:G85"
            Selection.ExportAsFixedFormat Type:=xlTypePDF
            filesavename = Application.GetSaveAsFilename(, "PDF Files (*.pdf), *.pdf")
0
NeOXi-_Alpha Messages postés 65 Date d'inscription mardi 13 novembre 2018 Statut Membre Dernière intervention 31 mai 2019
20 mars 2019 à 11:36
en faite j'ai trouvé merci quand même
0