Export Excel : vérifier si un fichier du même nom existe

Bonjour,

J'ai réalisé un export de mon tableau au format xls.

Le seul soucis est que je ne sais pas comment faire pour vérifier si un fichier du même nom existe car si un fichier du même nom existe, cela crée un bug.

Option Explicit

Dim Fdép, F, NomFdest, Fdest, ColDest, Col, I, Flag

    Sub Enr_XLS()
    Dim chemin As String, Fichier As String
    Dim NbLg As Long
    Dim resultat As String
      resultat = Application.InputBox("Souhaitez-vous garder la version de document ?", "Version du document", Range("X1")) 'La variable reçoit la valeur entrée dans l'InputBox
    On Error GoTo Suite
    If resultat = False Then Exit Sub
Suite:
On Error GoTo 0
     Range("X1") = resultat
      'If resultat = ""

      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      chemin = ThisWorkbook.path & Application.PathSeparator
      'Je donne le nom du fichier Offre de prix _ nom du chantier_ N° de version
      Fichier = "ODP" & "_" & Range("T4").Value & "_" & Range("I6").Value & "_" & Range("X1").Value & "_" & Range("V1").Value
      'Je copie uniquement l'offre de prix

      Sheets("offre de prix").Copy

      With ActiveWorkbook
        With .Sheets(1).UsedRange  'plage utilisée
          .Columns("A:X").Formula = .Columns("A:X").Value    'conservation uniquement des valeurs
          .Columns("Y:AF").EntireColumn.Delete
          .Range("I1:X2").Interior.Color = RGB(33, 89, 103)
          .Range("I3:X5").Interior.Color = RGB(183, 222, 232)
          .Range("A1").Select

        End With
           ActiveSheet.Shapes("BP_Image_IPR").Select
          Selection.Delete
        .SaveAs chemin & Fichier & ".xlsx"
         ActiveWorkbook.Save
         CONSULTATION.Hide
        '.Close
      End With
      MsgBox "Le Fichier " & Fichier & " a été généré. Il se trouve dans le répertoire " & chemin

    End Sub

J'ai mis le code ci-dessous mais est ce bien fait?

Option Explicit

Dim Fdép, F, NomFdest, Fdest, ColDest, Col, I, Flag

    Sub Enr_XLS()
    Dim chemin As String, Fichier As String
    Dim NbLg As Long

    Dim resultat As String
      resultat = Application.InputBox("Souhaitez-vous garder la version de document ?", "Version du document", Range("X1")) 'La variable reçoit la valeur entrée dans l'InputBox
    On Error GoTo Suite
    If resultat = False Then Exit Sub
Suite:
On Error GoTo 0
     Range("X1") = resultat
      'If resultat = ""

      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      chemin = ThisWorkbook.path & Application.PathSeparator
      'Je donne le nom du fichier Offre de prix _ nom du chantier_ N° de version
      Fichier = "ODP" & "_" & Range("T4").Value & "_" & Range("I6").Value & "_" & Range("X1").Value & "_" & Range("V1").Value

      'Je copie uniquement l'offre de prix

      Sheets("offre de prix").Copy

      With ActiveWorkbook
        With .Sheets(1).UsedRange  'plage utilisée
          .Columns("A:X").Formula = .Columns("A:X").Value    'conservation uniquement des valeurs
          .Columns("Y:AF").EntireColumn.Delete
          .Range("I1:X2").Interior.Color = RGB(33, 89, 103)
          .Range("I3:X5").Interior.Color = RGB(183, 222, 232)
          .Range("A1").Select

        End With
           ActiveSheet.Shapes("BP_Image_IPR").Select
          Selection.Delete
        If Dir(chemin & Fichier) <> "" Then
        'le fichier existe déjà
       Workbooks.Open (chemin & Fichier & ".xlsx")
    Else
        .SaveAs chemin & Fichier & ".xlsx"
         ActiveWorkbook.Save

    End If
         CONSULTATION.Hide
        '.Close
      End With
      MsgBox "Le Fichier " & Fichier & " a été généré. Il se trouve dans le répertoire " & chemin

    End Sub

Hello,

A voir si ton fichier bug ou pas?

Regarde les codes de test si le fichier existe dans un répertoire sur le site ci-dessous.

http://www.rondebruin.nl/win/s9/win003.htm

En fait, j'ai trouvé mon bug.

Si le fichier qui existe déjà était ouvert et que je relançais un enregistrement, ca plantait.

donc j'ai modifié le code mais ca n'a pas l'air de fonctionner.

C'est quoi ton code qui marche pas ?

Essaye d'être plus clair.

J'ai essayé avec le code suivant

Option Explicit

Dim Fdép, F, NomFdest, Fdest, ColDest, Col, I, Flag

    Sub Enr_XLS()
    Dim chemin As String, Fichier As String
    Dim NbLg As Long
    Dim Verification As Boolean
    Dim resultat As String
      resultat = Application.InputBox("Souhaitez-vous garder la version de document ?", "Version du document", Range("X1")) 'La variable reçoit la valeur entrée dans l'InputBox
    On Error GoTo Suite
    If resultat = False Then Exit Sub
Suite:
On Error GoTo 0
     Range("X1") = resultat
      'If resultat = ""

      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      chemin = ThisWorkbook.path & Application.PathSeparator
      'Je donne le nom du fichier Offre de prix _ nom du chantier_ N° de version
      Fichier = "ODP" & "_" & Range("T4").Value & "_" & Range("I6").Value & "_" & Range("X1").Value & "_" & Range("V1").Value

      'Je copie uniquement l'offre de prix

      Sheets("offre de prix").Copy

      With ActiveWorkbook
        With .Sheets(1).UsedRange  'plage utilisée
          .Columns("A:X").Formula = .Columns("A:X").Value    'conservation uniquement des valeurs
          .Columns("Y:AF").EntireColumn.Delete
          .Range("I1:X2").Interior.Color = RGB(33, 89, 103)
          .Range("I3:X5").Interior.Color = RGB(183, 222, 232)
          .Range("A1").Select

        End With

          ActiveSheet.Shapes("BP_Image_IPR").Select
          Selection.Delete
        On Error Resume Next
    Workbooks(chemin & Fichier & ".xlsx").Activate
    If Err <> 0 Then
        .SaveAs chemin & Fichier & ".xlsx"
         ActiveWorkbook.Save
    Else: MsgBox "Le classeur Fichier est déjà ouvert"
    End If

         CONSULTATION.Hide
        '.Close
      End With
      MsgBox "Le Fichier " & Fichier & " a été généré. Il se trouve dans le répertoire " & chemin

    End Sub

mais j'ai l'erreur ci-jointe