Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Générer PDF et choix d'annuler ou écraser si existe déjà sous ce nom

Leguyl

XLDnaute Occasionnel
Je génère mes PDF pour les devis en les nommant avec les 8 premières lettres du nom du client suivi du n° de devis présent en C9 suivi d'un tiret et la date du jour, à l'aide de ce code VBA :

VB:
Sub ExportDevisPDF()

    Dim Chemin As String
    
    Chemin = ActiveWorkbook.Path

    If MsgBox("Êtes-vous certain de vouloir générer un PDF Devis ?", vbYesNo, "Demande de confirmation") = vbYes Then
    
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & "\PDF\Devis\" & UCase(Left([ClientNom], 8)) & " - " & [C9] & " - " & Format(Date, "yyyy-mm-dd") & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties _
        :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
        MsgBox "Le PDF a été généré dans le sous-répertoire \PDF\Devis"
    
    Else
    
        MsgBox "Le PDF n'a pas été généré"
    
    End If
    
End Sub
J'aimerais être prévenu si un fichier portant le même nom existe déjà dans le répertoire de destination et donc avoir la possibilité de l'écraser ou annuler.

Merci d'avance,
Leguyl
 
Dernière édition:
Solution
Bonjour Leguyl, le forum

Je te propose :
VB:
Sub ExportDevisPDF()

Dim Chemin As String
Dim NFichier As String

Chemin = ActiveWorkbook.Path & "\PDF\Devis\"
NFichier = UCase(Left([ClientNom], 8)) & " - " & Format(Date, "yyyy-mm-dd") & ".pdf"

If NFichier = "" Then Exit Sub
If Dir(Chemin & NFichier) <> "" Then
    'le fichier existe déjà et suivant réponse de l'utilisateur
    If MsgBox("Le fichier existe déjà, voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Confirmation") = vbYes Then
        'Création du fichier PDF
          ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
 
        MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf &...

Phil69970

XLDnaute Barbatruc
Bonjour Leguyl, le forum

Je te propose :
VB:
Sub ExportDevisPDF()

Dim Chemin As String
Dim NFichier As String

Chemin = ActiveWorkbook.Path & "\PDF\Devis\"
NFichier = UCase(Left([ClientNom], 8)) & " - " & Format(Date, "yyyy-mm-dd") & ".pdf"

If NFichier = "" Then Exit Sub
If Dir(Chemin & NFichier) <> "" Then
    'le fichier existe déjà et suivant réponse de l'utilisateur
    If MsgBox("Le fichier existe déjà, voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Confirmation") = vbYes Then
        'Création du fichier PDF
          ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
 
        MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
    Else
        MsgBox "Le PDF n'a pas été crée", vbCritical, "Le fichier existe déjà"
        Exit Sub
    End If
 
Else
    'créer le pdf
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
 
    MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
End If
End Sub

*Attention : Code édité et modifié à 11h 51 pour tenir compte de :
J'aimerais être prévenu si un fichier portant le même nom existe déjà dans le répertoire de destination et donc avoir la possibilité de l'écraser ou annuler.

@Phil69970
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…