Verifier si fichier existe ET REMPLACER un onglet

bonjour a tous

j'ai un fichier qui me permet de créer une feuille que j'exporte dans un nouveau classeur.

Sub ExporterFiche()
    Dim Chemin As String, Nom As String
    Dim Shp As Shape
    Dim Sh As Worksheet

    Chemin = ThisWorkbook.Path & "\Fiche Site\"
    Nom = Sheets("FICHE").Range("B3")

    'Copie des 3 onglets dans un nouveau classeur
    Sheets(Array("FICHE")).Copy

    'Suppression des contrôles Shapes
    For Each Sh In ActiveWorkbook.Worksheets
        For Each Shp In Sh.Shapes
            Shp.Delete
        Next
    Next

    'Sauvegarde du nouveau classeur
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Chemin & Nom
        ActiveWorkbook.Close False
    Application.DisplayAlerts = False
MsgBox "La fiche est copier"

End Sub

je cherche le moyen

1) vérifier si le classeur existe si oui message "voulez vous remplacer"

2) si le classeur existe remplacer uniquement l'onglet "FICHE"

3) s'il n'existe pas le créer

Merci de votre aide

Bonjour,

Pour verifier l'existence du fichier, on utilise l'objet FSO

Voici un exemple

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.Fileexists(Application.ActiveWorkbook.Path & "\log.txt") Then
MsgBox ("existe deja")
.......

Ce code veifie l'existence d'un fichier log.txt dans le meme repertoire que le fichier excel

Pour verifier la feuille voici un code qui fonctionne trés bien volé sur un autre site

Public Function FeuilleExiste(FeuilleAVerifier As String) As Boolean
'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
'par Excel-Malin.com ( https://excel-malin.com )
Dim Feuille
    FeuilleExiste = False
    For Each Feuille In Sheets
        If UCase(Feuille.Name) = UCase(FeuilleAVerifier) Then
            FeuilleExiste = True
            Exit Function
        End If
    Next Feuille
Exit Function
End Function

Bon codage

Cdlt

bonjour à tous,

une proposition (code non optimisé)

Sub ExporterFiche()
    Dim Chemin As String, Nom As String
    Dim Shp As Shape
    Dim Sh As Worksheet

    Chemin = ThisWorkbook.Path & "\Fiche Site\"
    Nom = Chemin & Sheets("FICHE").Range("B3")
    If Dir(Nom) = "" Then
        'Copie de l' onglet FICHE  dans un nouveau classeur
        Sheets(Array("FICHE")).Copy

        'Suppression des contrôles Shapes
        For Each Sh In ActiveWorkbook.Worksheets
            For Each Shp In Sh.Shapes
                Shp.Delete
            Next
        Next

        'Sauvegarde du nouveau classeur
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Nom
        ActiveWorkbook.Close False
        Application.DisplayAlerts = False
        MsgBox "La fiche est copiée dans un nouveau classeur"
    Else
        Set wb = Workbooks.Open(Nom)
        Application.DisplayAlerts = False
        On Error Resume Next
        wb.Sheets("fiche").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        'Copie de l' onglet FICHE dans le classeur existant
        ThisWorkbook.Sheets(Array("FICHE")).Copy after:=wb.Sheets(wb.Sheets.Count)

        'Suppression des contrôles Shapes
        For Each Sh In wb.Sheets("fiche").Shapes
            For Each Shp In Sh.Shapes
                Shp.Delete
            Next
        Next
        wb.Save
        MsgBox "la fiche est copiée dans le classeur " & Nom
    End If
End Sub

Bonjour h2so4 et fg2b

fg2b
Merci pour cette information mais je ne sait pas la mettre en place dans mon Code.

h2so4
cette parti du code ne fonctionne pas

le classeur est écraser. Merci tout de même

Set wb = Workbooks.Open(Nom)

        Application.DisplayAlerts = False
        On Error Resume Next
        wb.Sheets("FICHE").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        'Copie de l' onglet FICHE dans le classeur existant
        ThisWorkbook.Sheets(Array("FICHE")).Copy after:=wb.Sheets(wb.Sheets.Count)

bonjour,

j'ai du mal à comprendre le problème.

la macro ouvre le fichier mentionné en B3, y supprime l'onglet "FICHE" et copie l'onglet "FICHE" du classeur contenant la macro vers ce fichier dont le nom est en B3, puis sauve ce fichier dont le nom est en B3. Le nom du fichier en B3 doit être différent de celui de ton classeur principal, sinon je ne comprends pas l'utilité de cette macro. Sinon est-ce bien le code ci-dessus que tu as exécuté sans le modifier ? Si tu l'as modifié, désolé je ne peux pas t'aider sans voir les modifications.

Re

la macro ouvre le fichier mentionné en B3, y supprime l'onglet "FICHE" et copie l'onglet "FICHE"

non la macro n'ouvre pas le fichier elle l'écrase

le but de cette macro est : a partir de mon fichier "BASE DE DONNE" je créer des classeurs au nom du lieux "coulommiers" "lagny" etc... plusieurs sites (146)

dans ces classeurs il y aura la "FICHE" et des photos

la "Fiche" est mise a jour régulièrement mais le classeur doit être complet avec les photos.

actuellement j'ai ceci alors que le classeur est déjà créer.

j'espère avoir été assez clair.

Merci de ton Aide

re-bonjour,

le message que tu reçois si le fichier existe, me laisse penser que tu n'exécutes pas le code que j'ai mis ou que tu as mal adapté le code.

J'ai fait un copier coller de ton code.

ci-

joint mon fichier test

bonjour,

J'ai fait un copier coller de ton code.

voici mon fichier avec le code qui fonctionne. exécute-le 2 fois d'affilée, la première fois il crée le fichier, les fois suivantes il remplace la fiche. (le code a été légèrement adapté par rapport à celui que j'ai mis sur le forum, pour gérer le cas où il n'y aurait que le seul onglet "FICHE" dans le fichier à modifier.)

C'est un truc de fou

je viens de faire le teste avec ton fichier

en premier cela créer le classeur SUPER

je ferme tout j'ouvre le fichier nouvellement créer et ajoute dans un nouvel onglet une photo j'enregistre et je ferme.

je retourne sur ton fichier et lance la macro et la message

je vérifie le fichier et la plus de photo et un seul onglet donc écrasé.

si cela marche chez toi je comprend plus rien il va peut etre falloir que je trouve une autre solution

mais je confirme c'est un truc de fou

en tout cas merci de ton aide.