Supprimer image + couleur de l'onglet en VBA

Bonjour à tous et merci d’avance pour votre aide 😊

Je débute en vba et macro sur Excel.

J’ai créé un fichier excel pour faire des fiches de métiers, à remplir, et faciliter la création de celle-ci par d’autre utilisateur.

Il y a quatre boutons de commandes, qui représente une couleur chaque une, pour classer les métiers par branches et un bouton sauvegarder qui copie ma feuille.

Mon problème est le suivant ;

Je n’arrive pas à supprimer l’image, de la feuille « Fiche base », après la copie de celle-ci…mon code vba s’arrête car le nom de l’image n’est pas correct…correction faite, ça fonctionne. Mais dès la création d’une nouvelle fiche, à nouveau le même problème. Et pour ce qui est de ma copie « Fiche base (2) », je dois uniquement supprimer les boutons de commandes…pour ça c’est ok, mais je n’arrive pas à mettre l’onglet de la feuille de la même couleur que la fiche. Voir mon fichier pour mieux comprendre.

Bonjour,

Pour supprimer une image :

Sub SuppImage()
Set objFeuille = ActiveSheet
objFeuille.Pictures.Delete
End Sub

Mais le mieux est déjà de lui donner un nom

bonjour,

un essai, l'image est coupé et collé au lieu de copier et les boutons ne se copient pas. Les cellules fusionnées causent toujours des problèmes.

Private Sub CommandButton1_Click()
     ' Sauvegarder_dans_nouvelle_feuille Macro

     Dim ws As Worksheet, shp As Shape

     Set wh = Worksheets("Fiche base")
     For Each shp In wh.Shapes
          If shp.TopLeftCell.Address = "$D$2" Then     'sélectionner l'image en D2
               Exit For
          Else
               Set shp = Nothing
          End If
     Next

     ' Copie la feuille avec les données
     wh.Copy After:=Worksheets(Sheets.Count)     'copier&coller "Fiche base"

     ' Renommage de la feuille
     If wh.Range("A1").Value <> "" Then
          On Error Resume Next
          ActiveSheet.Name = wh.Range("A1").Value
          On Error GoTo 0
     End If

     If Not shp Is Nothing Then     'si l'image existe, copier&coller image
          shp.Cut     'Copy
          ActiveSheet.Paste
          With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)     'positionner dernier shape dans cette feuille
               .Top = Range("D2").Top
               .Left = Range("D2").Left
          End With
     End If

     ' Effacer les données feuille vierge
     Application.Goto wh.Range("A1")
     Range("B2,A5,D5,A8,A11,A15,A18,D18,A21,A22,D22,A25,B28,D28").Select     'problèmes avec cellules fusionnées
     Selection.ClearContents
     Application.Goto wh.Range("A1")

End Sub

Bonjour Jefekoi et BsAlv,

Merci pour votre aide et votre temps, cela ma bien aidé .