Enregistrement automatique

Bonjour à tous,

J'ai une macro qui permet, en appuyant sur un bouton, d'enregistrer à un endroit précis, avec un format précis (.xlsm), des onglets precis de mon fichier excel.

Hors, dans mes onglets, j'ai des Combobox.

Si je fais "Fichier, enregistrer sous, .......xlsm" cela enregistre tout bien mais avec tous les onglets.

Mon code fait la même chose, mais il ne garde pas mes combobox, je ne sais pas pourquoi ??

 Dim extension As String
    Dim chemin As String, nomfichier As String
    Dim style As Integer
    Application.ScreenUpdating = False

       feuilleactive = ActiveSheet.Name
        Sheets(Array(feuilleactive, "Famille", "Team")).Copy

    extension = ".xlsm"
    chemin = "c:\DATAS\"
    nomfichier = ActiveSheet.Range("A1") & "Fiche_" & Range("H5") & extension
    With ActiveWorkbook
    'With ThisWorkbook
        .ActiveSheet.DrawingObjects.Delete
        .SaveAs Filename:=chemin & nomfichier, FileFormat:=52, CreateBackup:=False
        MsgBox "Fichier sauvegardé"
    End With
     End If
    End Sub

Supprimer la ligne .ActiveSheet.DrawingObjects.Delete, désolé...

Hum, en supprimant la ligne

.ActiveSheet.DrawingObjects.Delete

cela me garde bien mes Combobox mais egalement tous mes boutons (formes) dont je n'ai plus besoin.

Y a t-il un moyen de garder que les Combobox ?

Bonsoir Anne,

je te propose ce code VBA :

Option Explicit

Sub Macro1()
  Dim chemin$, nomfichier$, extension$, feuilleactive$, shp As Shape
  feuilleactive = ActiveSheet.Name: Application.ScreenUpdating = False
  Worksheets(Array(feuilleactive, "Famille", "Team")).Copy
  chemin = "c:\DATAS\": extension = ".xlsm"
  nomfichier = [A1] & "Fiche_" & [H5] & extension
  With ActiveWorkbook
    For Each shp In .ActiveSheet.Shapes: shp.Delete: Next shp
    .SaveAs Filename:=chemin & nomfichier, FileFormat:=52
  End With
  MsgBox "Fichier sauvegardé"
End Sub

ATTENTION !

exécute ce code sur une copie de ton fichier, et vérifie si ça te supprime pas des formes que tu aurais voulu garder !

dhany

Hello dhany,

Merci de ton implication, mais hélas cela supprime tout :/

oh la ! heureusement qu'j'avais indiqué d'faire un essai sur une copie du fichier réel ! hélas, j'ai pas d'autre solution à proposer. continue quand même de surveiller les futures réponses ; bonne chance !

dhany

dhany a écrit :

oh la ! heureusement qu'j'avais indiqué d'faire un essai sur une copie du fichier réel ! hélas, j'ai pas d'autre solution à proposer. continue quand même de surveiller les futures réponses ; bonne chance !

dhany

Non pas de soucis, j'ai bien entendu effectuer cette macro sur une sauvegarde, mais elle fait le même effet que la mienne à savoir supprimer tous ce qui est dessins, combobox, bouton....

Bonjour,

Si tu avais joint une copie de ton fichier avec juste les objets (les données et les macros, tu peux les supprimer, il n'y en a pas besoin) Tu aurais gagné du temps : Avec une boule de cristal on fait rarement du bon travail...

A+

Voici une partie du fichier.

En l'état tout fonctionne mais j'aimerai seulement que lors de la sauvegarde dans le nouveau fichier il supprime les bouton ACCUEIL et ENREGISTRER.

J'avais mis

.ActiveSheet.DrawingObjects.Delete

mais cela supprime la combobox

je te retourne ton fichier modifié :

Ctrl e ➯ tes 2 boutons "ACCUEIL" et "ENREGISTRER" ont été supprimés, et rien d'autre !

Alt F11 pour voir le code VBA, puis revenir sur Excel ; regarde d'abord la sub Essai()

puis dans ta sub Depart(), le bloc With qui est juste après ton With ActiveWorkbook

dhany

Parfait Dhany Merci !

En revanche, en l'état, si je clique sur mon bouton ENREGISTRER, il bloque sur

 .Shapes("Rectangle 15").Delete: 

Sub Depart()

    Dim extension As String
    Dim chemin As String, nomfichier As String
    Dim style As Integer
    Application.ScreenUpdating = False

    feuilleactive = ActiveSheet.Name
    Sheets(Array(feuilleactive, "Users")).Copy

    extension = ".xlsm"
    chemin = "c:\DATAS\fiches_de_mouvements\"
    nomfichier = ActiveSheet.Range("A1") & "Fiche_Mouvement_" & Range("H5") & extension
    With ActiveWorkbook
       With .Worksheets("Depart")
       .Shapes("Rectangle 15").Delete: .Shapes("Groupe 16").Delete
       End With
       .SaveAs Filename:=chemin & nomfichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
       MsgBox "Fichier sauvegardé"
    End With

End Sub

En gros, dans le cheminement, quand je clique sur le bouton ENREGISTRER, il faut :

• qu'il enregistre à l'emplacement voulu (OK) avec le nom voulu (OK)
• qu'il ouvre ce fichier (OK)
• qu'il supprime dans ce fichier les 2 boutons (NOK)

Ok j'ai trouvé ^^

il y a un point en trop déjà ici

   With .Worksheets("Depart")

Et ensuite dans mon exemple, quand il me crée le 2eme fichier, il me renomme les bouton;

"Rectangle 15" en "Rectangle A" et "Groupe 16" en "Groupe 2"

Normalement je devrais avancer et m"en sortir, merci beaucoup !!!