Supprimer bouton après archivage

Bonjour,

Voila, je souhaite archiver chaque jour du mois dans un classeur via un bouton, et une fois la feuille dans le classeur, je souhaite que ce bouton soit supprimé.

Je l'ai inscris dans la macro mais cela ne fonctionne.

Quelque chose ne va pas dans le code selon vous ?

    Dim cheminDestination As String
    cheminDestination = "C:\Users\Astro\documents\archive.xlsx"

    ' Copie la feuille active dans un nouveau classeur
    ActiveSheet.Copy

    ' Renomme la feuille avec la date du jour
    With ActiveWorkbook.Sheets(1)
        .Name = Format(Date, "dd mmmm yyyy")
    End With

    ' Enregistre le nouveau classeur
    ActiveWorkbook.SaveAs Filename:=cheminDestination

    ' Passe au nouveau classeur
    Set nouveauClasseur = ActiveWorkbook

    ' Supprime le bouton (avec gestion des erreurs)
    On Error Resume Next
    nouveauClasseur.Sheets(1).Shapes("VotreBouton").Delete
    On Error GoTo 0

    ' Ferme le nouveau classeur
    nouveauClasseur.Close False

Merci beaucoup !

Bonjour,

La copie d'une feuille n'inclue pas les Shapes donc ce code suffit :

Sub test()
Sub test()
    Dim cheminDestination As String
    cheminDestination = "C:\Users\Astro\documents\archive.xlsx"
    ' Copie la feuille active dans un nouveau classeur
    ' Mais pas la Shape !
    ActiveSheet.Copy
    ' Renomme la feuille avec la date du jour
    With ActiveWorkbook.Sheets(1)
        .Name = Format(Date, "dd mmmm yyyy")
    End With
    ' Enregistre le nouveau classeur
    ActiveWorkbook.SaveAs Filename:=cheminDestination
    ' Ferme le nouveau classeur
    ActiveWorkbook.Close
End Sub

A+

Bonsoir !

Merci de ton aide !

Je voulais utilisé le Shape afin de supprimer le bouton qui est lié à ma Macro dans le classeur d'archivage. Sauf que cela ne fonctionnait pas. As-tu une solution pour cela ?

Je ne sais pas !

Je pense qu'une macro ne peut pas s'auto-détruire.

Il faudrait sans doute utiliser une macro de destruction externe (située dans un autre classeur ou dans un perso.xlam...)

A+

Bonsoir,

Si l'onglet "archivé" ne comporte qu'un seul objet, peut-être ainsi?

    Dim cheminDestination As String
    Dim Shp As Shape
    cheminDestination = "C:\Users\Astro\documents\archive.xlsx"

    ' Copie la feuille active dans un nouveau classeur
    ActiveSheet.Copy

    ' Renomme la feuille avec la date du jour
    With ActiveWorkbook.Sheets(1)
        .Name = Format(Date, "dd mmmm yyyy")
        For Each Shp In .Shapes
            Shp.Delete
        Next Shp
    End With

    ' Enregistre le nouveau classeur
    ActiveWorkbook.SaveAs Filename:=cheminDestination

    ' Passe au nouveau classeur
    Set nouveauClasseur = ActiveWorkbook

    ' Ferme le nouveau classeur
    nouveauClasseur.Close False

Merci à tous les deux pour votre apport !!
Le code de Cousinhub fonctionne, super content !

Un problème en appel souvent un autre ^^
Je me suis rendu compte que le code créait à chaque fois un nouveau classeur, or je veux ajouter une feuille au classeur à la suite sans créer constamment de nouveaux fichiers.
J'ai modifié le code en gardant, l'ajout de Cousinhub, cela fonctionne mais ce qui m'embête c'est que la copie ne prend pas en compte toutes les propriétés de la feuille, notamment la largeur des lignes...

Avez-vous une solution ?
Encore merci.

Sub Archive()

    Dim cheminDestination As String
    Dim Shp As Shape
    Dim wb As Workbook

    cheminDestination = "C:\Users\Astro\documents\archive.xlsx"

    ' Vérification si le fichier existe déjà
    If Dir(cheminDestination) <> "" Then
        Set wb = Workbooks.Open(cheminDestination)
    Else
        ActiveSheet.Copy
        Set wb = ActiveWorkbook
        wb.SaveAs Filename:=cheminDestination
    End If

    ' Copier toute la feuille active et coller dans la nouvelle feuille
    ActiveSheet.UsedRange.Copy
    With wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        .Name = Format(Date, "dd mmmm yyyy")
        .Range("A1").PasteSpecial xlPasteAll
        For Each Shp In .Shapes
            Shp.Delete
        Next Shp
    End With

    ' Enregistrer les modifications
    wb.Save

    ' Display confirmation message (added)
    MsgBox "Le fichier a été enregistré avec succès à l'emplacement: " & cheminDestination, vbInformation, "Archivement réussi"

    wb.Close False

End Sub