Inserer - rectangle - macro dans plusieurs feuilles

Bonjour à tous,

Pour une application de gestion des dépenses pour 2 véhicules, j'ai besoin d'une feuille "paramètre" et de deux feuilles identiques (2 véhicules).

Dans la première feuille j'ai fait:

Insertion - Formes - rectangle dans lequel j'insère une macro.

Dans la macro je tape le texte : (Mise à Jour) dans une couleur verte.

Lorsque l'on appelle la macro je modifie le texte (Fin de Mise à Jour) dans une couleur rouge.

La procédure fonctionne.

Mais lors de la copie pour la deuxième feuille le rectangle change de nom : Rectangle 1 ---> Rectangle 2.

Pour ne pas créer deux procédures, comment écrire la procédure?

Sub Maj_O1()
    ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select  'devient Rectangle 2
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.6000000238
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Mise à Jour"
End Sub

Si plusieurs solutions, je prends avec plaisir.

A bientôt

Annette

Bonjour

Sans connaitre ton fichier

Si qu'une forme dans chaque feuille essayes

Sub Maj_O1()
  'ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select  'devient Rectangle 2
  ActiveSheet.Shapes(1).Select  'devient Rectangle 2
  With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorText2
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0.6000000238
    .Transparency = 0
    .Solid
  End With
  Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Mise à Jour"
End Sub

Merci pour cette réponse,

Dans chaque feuille, il n'y avait qu'un "rectangle".

La proposition de modifier:

  ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select

par

 ActiveSheet.Shapes(1).Select

me convient.

Annette

Rechercher des sujets similaires à "inserer rectangle macro feuilles"