Refuser d'enregistrer sous nom existant

Bonjour groupe,

J'ai une macro ici qui crée un PDF de ma feuille de calcul et qui enregistre le PDF. Par contre, je ne veux pas qu'il enregistre sous un nom déjà existant.

J'ai indiqué dans ma macro l'endroit ou je crois que l'on doit faire la vérification...mais je ne sais pas comment le faire.

Pourriez-vous m'aider?

Bonjour

Peut être un essai comme ça :

Option Explicit
Sub enregistrer()
Dim nomPdf As String

    If IsEmpty(Range("A12")) Then MsgBox "LE NOM DU FOURNISSEUR doit être inscrit": Range("a12").Select: End
    If IsEmpty(Range("o5")) Then MsgBox "LIVRÉ A doit être inscrit": Range("o5").Select: End
    If IsEmpty(Range("l32")) Then MsgBox "LE NOM DU REQUÉRANT doit être inscrit": Range("l32").Select: End
    If IsEmpty(Range("g16")) Then MsgBox "EXPÉDIÉ VIA doit être inscrit": Range("g16").Select: End
    If IsEmpty(Range("o7")) Then MsgBox "DOSSIER EAD doit être inscrit": Range("o7").Select: End

    nomPdf = "\\nasead01\administration\documents\a\" & Range("B2").Value & " " & Range("r2") & "-" & Range("aa2") & " " & Range("o5")
    If ExistePdf(nomPdf) Then
        MsgBox "Ce fichier Existe déjà", vbCritical, "Attention"
    Else
        ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomPdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        Range("o5:v8") = ""
        Range("A12") = "Vitrerie"
        Range("a21:w31") = ""
        Range("l3") = ""
        Range("q34") = ""
    End If

End Sub

Function ExistePdf(nomPdf) As Boolean

    ExistePdf = True

    On Error GoTo nonExistePdf
    Open nomPdf For Input As 1
    Close #1
suite:
    On Error GoTo 0
    Exit Function

nonExistePdf:
    ExistePdf = False
    GoTo suite
End Function

Merci pour ta réponse,

Je ne sais pas si tu l'a testé de ton coté mais pour ma part, ca ne fonctionne pas. Il enregistre et écrase quand même le fichier existant.

Aurais tu une autre idée a la limite?

Merci!

Bonjour

Oui... effectivement après re-re-lecture de mon code il y a une erreur de débutant

Il suffit d'inverser True et False dans la procédure ExistePdf et ça fonctionne !

Désolé

Bonjour à tous,

en fait, pas vraiment besoin de créer une fonction, il y a déjà ce qu'il faut :

    fich = "D:\tmp\fichier.pdf"
    If Dir(fich) = "" Then
        ' fich n'existe pas
    Else
        ' fich existe
    End If

eric

(..)

@eriiic

Oui je sais, mais je trouve tellement plus sympa de dire If ExistePdf du coup je m'embrouille les pinceaux

Désolé mon incompétance mais les deux solution ne fonctionne pas.

Dans les deux cas, il ne fait pas la vérification et ca passe toujours.

Voici le code d'eriiic que j'ai mis dans mon fichier

Option Explicit
Sub enregistrer()
Dim nompdf As String

If IsEmpty(Range("A12")) Then MsgBox "LE NOM DU FOURNISSEUR doit être inscrit": Range("a12").Select: End
If IsEmpty(Range("o5")) Then MsgBox "LIVRÉ A doit être inscrit": Range("o5").Select: End
If IsEmpty(Range("l32")) Then MsgBox "LE NOM DU REQUÉRANT doit être inscrit": Range("l32").Select: End
If IsEmpty(Range("g16")) Then MsgBox "EXPÉDIÉ VIA doit être inscrit": Range("g16").Select: End
If IsEmpty(Range("o7")) Then MsgBox "DOSSIER EAD doit être inscrit": Range("o7").Select: End

'ici je veux que la macro valide si le nom du fichier que je vais lui donner exsiste déja dans le répertoire. Si oui la macro cesse avec un msgbox.
nompdf = "\\nasead01\administration\documents\a\" & Range("B2").Value & " " & Range("r2") & "-" & Range("aa2") & " " & Range("o5")

If Dir(nompdf) = "" Then
    ' fich n'existe pas
         ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
         Range("o5:v8") = ""
         Range("A12") = "Vitrerie Commercial"
         Range("a21:w31") = ""
         Range("l3") = ""
         Range("q34") = ""

   Else
        ' fich existe
    MsgBox "Le fichier Existe déjà": End
   End If

Exit Sub

End Sub
 

Si nompdf est bien construit (l'as-tu contrôlé ??), sans doute un soucis avec le nom de chemin réseau, essaie avec la lettre du lecteur.

Test avec un fichier sur le disque dur pour t'en convaincre.

eric

Si je l'ai "contrôlé"?...désolé mais je ne sais pas ce que ça veux dire.

J'ai quand même changer la destination pour une destination sur l'ordi directement (c:\document) et ça ne fonctionne toujours pas. Le fichier écrase toujours celui existant. l'avez-vous testé sur votre ordinateur? Si oui je comprends plus RIEN!!!!

bonjour

ta version de la macro d'eriiic teste l'existence d'un fichier sans l'extension ".pdf" mais écrit un fichier avec l'extension ".pdf"

essaie ceci

Option Explicit
Sub enregistrer()
Dim nompdf As String

If IsEmpty(Range("A12")) Then MsgBox "LE NOM DU FOURNISSEUR doit être inscrit": Range("a12").Select: End
If IsEmpty(Range("o5")) Then MsgBox "LIVRÉ A doit être inscrit": Range("o5").Select: End
If IsEmpty(Range("l32")) Then MsgBox "LE NOM DU REQUÉRANT doit être inscrit": Range("l32").Select: End
If IsEmpty(Range("g16")) Then MsgBox "EXPÉDIÉ VIA doit être inscrit": Range("g16").Select: End
If IsEmpty(Range("o7")) Then MsgBox "DOSSIER EAD doit être inscrit": Range("o7").Select: End

'ici je veux que la macro valide si le nom du fichier que je vais lui donner exsiste déja dans le répertoire. Si oui la macro cesse avec un msgbox.
nompdf = "\\nasead01\administration\documents\a\" & Range("B2").Value & " " & Range("r2") & "-" & Range("aa2") & " " & Range("o5") & ".pdf"

If Dir(nompdf) = "" Then
    ' fich n'existe pas
        ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
         Range("o5:v8") = ""
         Range("A12") = "Vitrerie Commercial"
         Range("a21:w31") = ""
         Range("l3") = ""
         Range("q34") = ""

   Else
        ' fich existe
   MsgBox "Le fichier Existe déjà": End
   End If

Exit Sub

End Sub

Ça fonctionne. Un immense merci!