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 ?
bonsoir
c'est simple tu change le mode de remplissage
ajoute une shape la nomme"toto"
VB:
Sub add_shape_With_Image()
Dim shap As Shape
With ActiveSheet
Set shap = .Shapes.AddShape(msoShapeRectangle, 270.6, 312, 154.8, 101.4)
With shap
.Name = "toto"
.Fill.Visible = msoTrue
.Fill.UserPicture "C:\Users\Public\Pictures\Sample Pictures\Penguins.jpg"
End With
End With
End Sub
l'image ne me plait plus je la change
Code:
Sub change_l_image()
With ActiveSheet.Shapes("toto")
.Fill.UserPicture "C:\Users\Public\Pictures\Sample Pictures\Koala.jpg"
End With
End Sub
finalement je ne veux plus d'image dans cette shape ("toto")
ben on la rempli en solid
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
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
VB:
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
Une autre façon :
Concernant la 1ère question / Le nom des shapes présentent dans le classeur :
VB:
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 :
Code:
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.
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
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
VB:
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
Une autre façon :
Concernant la 1ère question / Le nom des shapes présentent dans le classeur :
VB:
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 :
Code:
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.
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.
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.
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 :
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.
Lorsque j'ai créé la macro en auto voici le code enregistré :
VB:
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 .