Modification code

Bonsoir,

J'ai un code qui fonctionne pas mal j'aimerais lui apporter une modif:

Lorsque j'enregistre j'aimerais qu'il me supprime les bouton sauf un nommer "dudu" mais qu'il me supprime pas les Shapes nommer "SP-"00".

Voici mon code.

Sub Archiver()
Dim ext$, chemin$, nomfich$, formatfich, o As Object
ext = ".xlsm" '.xlsx '.xls 'à adapter
chemin = "C:\Users\Dédé\Desktop\Text\"
nomfich = ThisWorkbook.Sheets(1).[K1]
formatfich = xlWorkbookNormal
If Val(Application.Version) >= 12 Then _
formatfich = IIf(ext = ".xls", 56, IIf(ext = ".xlsm", 52, 51))
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Copy
With ActiveWorkbook
  ThisWorkbook.Sheets(2).Copy After:=.Sheets(1)
  For Each o In .Sheets(1).DrawingObjects
    'If o.Name <> "dudu" Then o.Delete
    If TypeName(o) <> "OLEOBject" And o.Name <> "dudu" Then o.Delete
  Next
  .Sheets(1).Activate
  On Error Resume Next 'si nomfich n'est pas autorisé
  '.Sheets(1).DrawingObjects(2).Delete '??
  .SaveAs chemin & nomfich, formatfich
  .Close False
End With
End Sub

Je vous remercie d'avance

Max

Re,

Personne à une idée

@+

Bonsoir,

  For Each o In .Sheets(1).DrawingObjects
    If Left(o.Name, 3) <> "SP-" And Left(o.Name, 3) <> "dud" Then o.Delete
  Next

A+

Bonsoir

Je te remercie Nickel

Bonne soirée

Bonjour,

Avec la modif de galopind01 le code fonctionne très bien, je salut et remercie au passage.

J'ai un petit souci, lorsque j'enregistre tous se passe très bien sauf qu'il me prend pas les module standard ou se trouve mes codes

Je vous remercie d'avance et vous souhaite une bonne journée

Max

bonjour,

Essaie :

Sub Archiver()
 Dim ext$, chemin$, nomfich$, o As Object
 ext = ".xlsm" '.xlsx '.xls 'à adapter
  chemin = "C:\Users\Dédé\Desktop\Text\" '"C:\Users\Max\Desktop\Test\"
 nomfich = ThisWorkbook.Sheets(1).[K1] & ext
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False 'si le fichier existe déjà
 ThisWorkbook.Sheets(1).Copy
 With ActiveWorkbook
   ThisWorkbook.Sheets(2).Copy After:=.Sheets(1)

    For Each o In .Sheets(1).DrawingObjects
    If Left(o.Name, 3) <> "SP-" And Left(o.Name, 4) <> "Menu" Then o.Delete
  Next

   .Sheets(1).Activate
   On Error Resume Next 'si nomfich n'est pas autorisé
   .SaveAs chemin & nomfich
   .Close False
 End With
 End Sub

A+

Salut Galopin

Je n'arrive pas a enregistrer?

@+

Modifie cette ligne :

   .SaveAs chemin & nomfich, xlOpenXMLWorkbookMacroEnabled

A+