Msg d'erreur non justifié pour "écraser le fichier"

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Joe[PT]

XLDnaute Junior
Bonjour à tous,

J'ai créé une macro qui me permet de générer un devis au format PDF et de le sauvegarder sur mon PC. Cette macro fonctionne bien excepté un message d'erreur que j'ai inséré afin de ne pas écraser un fichier existant sans mon accord. De manière incompréhensible, le Msg d'alerte se déclenche dans tous les cas : que le PDF que je suis en train de sauvegarder existe déjà ou pas, j'ai toujours le message "Voulez-vous écraser"...

J'avoue que je ne vois pas d'où vient mon erreur.

Le code :
Code:
Sub Devis_Générer_PDF()
' Permet de générer une impression PDF d'une partie d'une feuille
' en sauvegardant le document .pdf avec un nom spécifique et dans répertoire déterminé

    Dim sRep As String                  ' Répertoire de sauvegarde
    Dim sFilename As String             ' Nom du fichier
    
    sRep = "C:\Users\Joe\OneDrive\Documents\Porto De Quintas\PdQ - Comptabilité\PdQ - Devis\"                       ' Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
    sFilename = Range("E9").Value & "." & "pdf"      ' Nom du fichier
    
        ' Vérifier si un fichier portant ce nom existe
        If sRep = (Range("E9").Value & "." & "pdf") <> "" Then
             If MsgBox("Un fichier ayant ce nom " & sFilename & " existe " & _
                "déjà dans ce répertoire " & sRep & "." & vbCrLf & _
                "Désirez-vous l'écraser ? ", vbCritical + vbYesNo, "Attention !") = vbNo Then
                 sFilename = Application.InputBox("Donner lui un nouveau nom.")
                 If Format(sFilename) = False Then
                      MsgBox "Opération de la Création des fichiers PDF annulée."
                 Else
             End If
         End If
    End If
    
' Impression PDF de la feuille "Devis"
    Range("A8:H67").Select
    Selection.ExportAsFixedFormat _
                     Type:=xlTypePDF, _
                     Filename:=sRep & sFilename, _
                     Quality:=xlQualityStandard, _
                     IncludeDocProperties:=True, _
                     IgnorePrintAreas:=False, _
                     OpenAfterPublish:=True
End Sub

Si quelqu'un se sent plus inspirer que moi, je reste à l'écoute de vos conseils 😉

Bonne journée à tous ! 🙂

Joe
 
Re : Msg d'erreur non justifié pour "écraser le fichier"

Bonjour Joe[PT],

En modifiant ton code comme ceci, ça devrait fonctionner:

Code:
Sub Devis_Générer_PDF()
' Permet de générer une impression PDF d'une partie d'une feuille
' en sauvegardant le document .pdf avec un nom spécifique et dans répertoire déterminé

Dim sRep As String                  ' Répertoire de sauvegarde
Dim sFilename As String             ' Nom du fichier
   
sRep =  "C:\Users\Joe\OneDrive\Documents\Porto De Quintas\PdQ - Comptabilité\PdQ - Devis\"                       ' Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
sFilename = Range("E9").Value & "." & "pdf"      ' Nom du fichier
   
' Vérifier si un fichier portant ce nom existe
If Dir(sRep & sFilename) <> "" Then
  If MsgBox("Un fichier ayant ce nom " & sFilename & " existe " & _
  "déjà dans ce répertoire " & sRep & "." & vbCrLf & _
  "Désirez-vous l'écraser ? ", vbCritical + vbYesNo, "Attention !") = vbNo Then
    sFilename = Application.InputBox("Donner lui un nouveau nom.")
    If Format(sFilename) = False Then
      MsgBox "Opération de la Création des fichiers PDF annulée."
    End If
  End If
End If
   
' Impression PDF de la feuille "Devis"
Range("A8:H67").Select
Selection.ExportAsFixedFormat _
  Type:=xlTypePDF, Filename:=sRep & sFilename, Quality:=xlQualityStandard, _
  IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Cordialement.
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
714
Réponses
32
Affichages
2 K
Retour