XL 2010 Trouver le nom des formes qui est sur un onglet

[jeanmi]

Bonjour à tous,

Je recherche s'il est possible de trouver le nom des formes qui sont sur un feuille (fonction insertion forme rectangle)
Si je fait une macro auto, je vois que les formes ce nommes, Rectangle, avec un numéro après.

Ma première question qui en comporte deux :
ou trouver ce nom ?
est-il possible de renommer ?

Ma deuxième question :

Est-il possible de copier une image dans cette forme( ça oui) mais sans déformation de l'image ?

Merci pour vos réponses

Cordialement

 

[nat54]

Bonjour,
Tu trouves le nom dans la zone en haut à gauche
Le nom de base était rectangle à bord arrondi, tu peux renommer en tant directement dans cette zone

 

[Dranreb]

Bonjour.

Sub Macro1()
   Dim Shp As Shape
   Set Shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 112.5, 29.25, 95.25, 30)
   Shp.Name = "Toto"
   Shp.Fill.UserPicture "C:\Users\Luck\Pictures\MàJ48².png"
   Shp.Width = 32: Shp.Height = 32
   End Sub

Sub Macro2()
   Dim Shp As Shape
   For Each Shp In ActiveSheet.Shapes
      MsgBox Shp.Name
      Shp.Fill.UserPicture "C:\Users\Luck\Pictures\MàJ48².png"
      Shp.Width = 32: Shp.Height = 32
      Next Shp
   End Sub

 

[Eric C]

Bonjour le forum
Bonjour jeanmi, nat54, Dranreb

Une autre façon :
Concernant la 1ère question / Le nom des shapes présentent dans le classeur :

Public Sub nom_Shape()
Dim forme As Shape
Dim Ws As Worksheet
For Each Ws In Worksheets
    For Each forme In Ws.Shapes
        MsgBox "la forme : " & forme.Name & " est présente en feuille " & Ws.Name
    Next forme
Next Ws
End Sub

1ère question / Renommer les Shapes
Ici, chaque shape prendra le noms du texte inscrit à l'intérieur de celle-ci :

Sub Renomme_Shape()
Dim Sh As Shape
  Application.ScreenUpdating = False
  For Each Sh In ActiveSheet.Shapes
     If Sh.Type = msoAutoShape Then
        Sh.Name = Sh.TextFrame.Characters.Text
      End If
   Next Sh
End Sub

La 2ème question : Lors du collage, il n'y a pas de déformation.

Bonne journée à toutes & à tous
@+ Eric c

 

[jeanmi]

Bonjour,
Tu trouves le nom dans la zone en haut à gauche
Le nom de base était rectangle à bord arrondi, tu peux renommer en tant directement dans cette zone
Regarde la pièce jointe 1121840

Bonjour @nat54 , bonjour à tous,

là j'ai un peut honte, car même pas regardé dans la fenêtre ou il y a la position des cellule.
Je fait profil bas.

Merci beaucoup

Cordialement

 

[jeanmi]

Bonjour.

Sub Macro1()
   Dim Shp As Shape
   Set Shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 112.5, 29.25, 95.25, 30)
   Shp.Name = "Toto"
   Shp.Fill.UserPicture "C:\Users\Luck\Pictures\MàJ48².png"
   Shp.Width = 32: Shp.Height = 32
   End Sub

Sub Macro2()
   Dim Shp As Shape
   For Each Shp In ActiveSheet.Shapes
      MsgBox Shp.Name
      Shp.Fill.UserPicture "C:\Users\Luck\Pictures\MàJ48².png"
      Shp.Width = 32: Shp.Height = 32
      Next Shp
   End Sub

bonjour @Dranreb , bonjour à tous,

Merci pour la réponse, mais les codes c'est pour quoi faire. j'ai pas bien compris.
Question peut-être bête.
cordialement

 

[jeanmi]

Bonjour le forum
Bonjour jeanmi, nat54, Dranreb

Une autre façon :
Concernant la 1ère question / Le nom des shapes présentent dans le classeur :

Public Sub nom_Shape()
Dim forme As Shape
Dim Ws As Worksheet
For Each Ws In Worksheets
    For Each forme In Ws.Shapes
        MsgBox "la forme : " & forme.Name & " est présente en feuille " & Ws.Name
    Next forme
Next Ws
End Sub

1ère question / Renommer les Shapes
Ici, chaque shape prendra le noms du texte inscrit à l'intérieur de celle-ci :

Sub Renomme_Shape()
Dim Sh As Shape
  Application.ScreenUpdating = False
  For Each Sh In ActiveSheet.Shapes
     If Sh.Type = msoAutoShape Then
        Sh.Name = Sh.TextFrame.Characters.Text
      End If
   Next Sh
End Sub

La 2ème question : Lors du collage, il n'y a pas de déformation.

Bonne journée à toutes & à tous
@+ Eric c

Bonjour @Eric C , bonjour à tous,

Merci pour les codes je vais tester.
Effectivement il n'y a pas de déformation mais l'image est coupée, il me semble, si la forme est trop petite pour accueillir l'image.

Cordialement

 

[jeanmi]

re bonjour à tous,

j'ai oublier une chose importante,

Est-il possible de supprimer l'image de la forme , sans supprimer l'image ????

Merci pour vos réponses

Cordialement

 

[Dranreb]

Importez l'image et mettez lui les mêmes Left et Top que la forme puis supprimez celle ci.

 

[jeanmi]

Importez l'image et mettez lui les mêmes Left et Top que la forme puis supprimez celle ci.

re @Dranreb et à tous,

Pour un non initier, j'ai rien compris à votre réponse ???
j'ai beau chercher à comprendre je ne trouve pas une explication pour faire un essai.
serait-il possible d'avoir une petite explication.

D'avance merci.

Cordialement

 

[Dranreb]

Peut être n'ai je pas compris ce que vous vouliez faire alors ?

 

[jeanmi]

Peut être n'ai je pas compris ce que vous vouliez faire alors ?

re @Dranreb

je pense que c'est moi qui ne comprend pas votre phrase ci-dessous :

Importez l'image et mettez lui les mêmes Left et Top que la forme puis supprimez celle ci

pour pouvoir mettre en application.

Cordialement

 

[Dranreb]

Je ne pourrais que répéter la même phrase.
Enregistrez une macro et importez une image pour avoir les instructions qui font ça.
Quand vous explorez les Shape, pour chacun d'eux insérez une image sur le modèle engendré par l'enregistreur.
Corrigez ses Left et Top conformément à ceux du Shape, puis supprimez celui ci.
Si toutefois par :

Est-il possible de supprimer l'image de la forme , sans supprimer l'image ????

vous entendiez ne garder que l'image mais plus la forme.

 

[jeanmi]

Je ne pourrais que répéter la même phrase.
Enregistrez une macro et importez une image pour avoir les instructions qui font ça.
Quand vous explorez les Shape, pour chacun d'eux insérez une image sur le modèle engendré par l'enregistreur.
Corrigez ses Left et Top conformément à ceux du Shape, puis supprimez celui ci.
Si toutefois par :vous entendiez ne garder que l'image mais plus la forme.

re ,

Lorsque j'ai créé la macro en auto voici le code enregistré :

Sub Macro1()

'Ajout d'un forme rectangle
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 270.6, 312, 154.8, 101.4).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With

'Mettre fond est bordure blanc
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
End With

'Coller image
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\Users\Public\image1.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With

End Sub

Après je voulais supprimer l'image qui est dans la forme, sans supprimer la forme, ou bien coller une nouvelle image à la place de l'ancienne sans supprimer la forme.

C'est ça que je n'ai pas compris comment faire, avec votre réponse : Importez l'image et mettez lui les mêmes Left et Top que la forme puis supprimez celle ci.

Surement que je me sui mal expliqué, j'espère que cette fois mon explication sera plus claire.

Merci d'avance pour votre réponse et votre patience .

Cordialement

 

[Dranreb]

Je ne sais pas, peut être .UserPicture = "", sinon enregistrez une macro et trouvez comment le faire manuellement pendant que ça enregistre.