Problème de shapes

bonjour,

J'ai une feuille avec une liste de noms en colonne A.

Je voudrais faire une macro qui puisse créer un shape genre étiquette de chaque nom (avec le nom inscrit) afin que je puisse bouger

ces étiquettes et les utiliser.

Merci de votre aide.

Bonsoir,

Ci-joint une proposition à tester.

Bonne soirée

Bouben

C'est difficile de faire mieux. En cherchant à comprendre ton code, j'ai même réussi à créer un bouton pour les effacer.

C'est super.

Merci beaucoup.

Bonjour,

Fonction qui crée et supprime des shapes automatiquement

Function CréeShape(groupe As Range, NomShape, Libelle)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  Set cel = Application.Caller
  NomShape2 = NomShape & "xx"
  For Each s In f.Shapes
   If Right(s.Name, 2) = "xx" Then
     If IsError(Application.Match(Left(s.Name, Len(s.Name) - 2), groupe, 0)) Then s.Delete
   End If
  Next s
  On Error Resume Next
  f.Shapes(NomShape2).Delete
  On Error GoTo 0
  f.Shapes.AddShape(msoShapeRectangle, 120#, 258.75, 52.5, 34.5).Name = NomShape2
  f.Shapes(NomShape2).Width = 45
  f.Shapes(NomShape2).Height = 13
  f.Shapes(NomShape2).Top = cel.Top
  f.Shapes(NomShape2).Left = cel.Left + cel.Width + 5
  f.Shapes(NomShape2).Fill.ForeColor.RGB = RGB(255, 0, 0)
  f.Shapes(NomShape2).Line.Visible = True
  f.Shapes(NomShape2).TextFrame.Characters.Text = Libelle
  f.Shapes(NomShape2).TextFrame.Characters.Font.Size = 9
  f.Shapes(NomShape2).TextFrame.Characters.Font.Color = vbBlack
  f.Shapes(NomShape2).TextFrame.Characters.Font.Bold = False
  f.Shapes(NomShape2).Fill.Transparency = 0.5
  CréeShape = ""
End Function

Ceuzin

C'est pas mal mais ta première proposition me convient mieux.

En tous cas merci pour le temps passé sur mon problème.

A bientôt peut-être